Курсовой проект групп 3341 и 3382 / DMAssociations / Apriori

unit Apriori;

interface

uses
Classes,
FastVector,
Instances,
DmmTypes,
Tag,
AttributeStats,
SysUtils,
uContainers,
AprioriItemSet,
utils,
DoubleObject,
ItemSet,
associator,
dmm,
Windows;

type

TDMApriori = class (TDMAssociator)
protected
//минимальная поддержка
m_minSupport : double;

//верхняя граница минимальной поддержки
m_upperBoundMinSupport : double;

//нижняя граница минимальной поддержки
m_lowerBoundMinSupport : double;

//выбранный тип метрики
m_metricType : integer;

//минимальная величина метрики
m_minMetric : double;

//максимальное число правил
m_numRules : integer;

//величина на которую уменьшаеся значение m_minSupport на каждой итерации
m_delta : double;

m_cycles : integer;

// все наборы
m_Ls : TDMFastVector;

//все наборы в хэш таблице
m_hashtables : TDMFastVector ;

m_outputItemSets : boolean;

m_removeMissingCols : boolean ;

//выдавать сообщения о ходе выполнения
m_verbose : boolean;

// Массив из всех возможных правил
m_allTheRules : array of TDMFastVector;

m_instances : TDMInstances ;

public
constructor Create();
function globalInfo() : AnsiString;
procedure resetOptions();
procedure setInstances(instances : TDMInstances);
procedure setNumRules(numRules : integer);
procedure setLowerBoundMinSupport(lowerBoundMinSupport : double);
procedure setMinMetric(minMetric : double);
procedure buildModel(instances : TDMInstances); override;
procedure ClearModel(); override;
function toString() : AnsiString;
function toStrings() : TStrings; override;
destructor Destroy(); override;

private
//поиск частых наборов
procedure findLargeItemSets(instances : TDMInstances);
//поиск правил
procedure findRulesQuickly();
end;

implementation

constructor TDMApriori.Create();
begin
m_Ls := nil;
m_hashtables := nil;
m_instances:=nil;
m_allTheRules := nil;
resetOptions();
end;

function TDMApriori.globalInfo() : AnsiString;
begin
result := 'Поиск ассоциативных правил';
end;

procedure TDMApriori.resetOptions();
begin
m_removeMissingCols := false;
m_verbose := false;
m_delta := 0.05;
m_minMetric := 0.90;
m_numRules := 100;
m_lowerBoundMinSupport := 0.1;
m_upperBoundMinSupport := 1.0;
m_outputItemSets := false;
end;

procedure TDMApriori.setInstances(instances : TDMInstances);
begin
m_instances := TDMInstances.Create(instances);
end;

procedure TDMApriori.setNumRules(numRules : integer);
begin
m_numRules := numRules;
end;

procedure TDMApriori.setLowerBoundMinSupport(lowerBoundMinSupport : double);
begin
m_lowerBoundMinSupport := lowerBoundMinSupport;
end;

procedure TDMApriori.setMinMetric(minMetric : double);
begin
m_minMetric := minMetric;
end;

procedure TDMApriori.findLargeItemSets(instances : TDMInstances);
var
kMinusOneSets : TDMFastVector;
kSets: TDMFastVector;
aprioriHashtable : TStringHashtable;
necSupport, necMaxSupport,i : integer;
begin
necSupport := 0;
necMaxSupport := 0;
i := 0;
necSupport := trunc(m_minSupport * instances.numInstances()+0.5);
necMaxSupport := trunc(m_upperBoundMinSupport * instances.numInstances()+0.5);

kSets := AprioriItemSet.singletons(instances);
ItemSet.upDateCounters(kSets, instances);
kSets := ItemSet.deleteItemSets(kSets, necSupport, necMaxSupport);
if (kSets.Size()<> 0) then
repeat
begin
m_Ls.addElement(kSets);
kMinusOneSets := kSets;
kSets := AprioriItemSet.mergeAllItemSets(kMinusOneSets, i, instances.numInstances());
aprioriHashtable := ItemSet.getHashtable(kMinusOneSets, kMinusOneSets.size());
m_hashtables.addElement(aprioriHashtable);
kSets := ItemSet.pruneItemSets(kSets, aprioriHashtable);
ItemSet.upDateCounters(kSets, instances);
kSets := ItemSet.deleteItemSets(kSets, necSupport, necMaxSupport);
inc(i);
end
until (kSets.size() <= 0);
FreeAndNil(kSets);
end;

procedure TDMApriori.findRulesQuickly();
var
rules : TDMFastVectorArray ;
j,k : integer;
currentItemSets : TDMFastVector;
enumItemSets : TDMFastVectorEnumeration;
currentItemSet : TDMAprioriItemSet;
begin
j := 1;
while (j < m_Ls.size()) do
begin
currentItemSets := m_Ls.elementAt(j) as TDMFastVector;
enumItemSets := TDMFastVectorEnumeration.Create(currentItemSets);
while (enumItemSets.hasMoreElements()) do
begin
currentItemSet := enumItemSets.nextElement() as TDMAprioriItemSet;
rules := currentItemSet.generateRules(m_minMetric, m_hashtables, j + 1);

k := 0;
while (k < rules[0].size()) do
begin
m_allTheRules[0].addElement(rules[0].elementAt(k));
m_allTheRules[1].addElement(rules[1].elementAt(k));
m_allTheRules[2].addElement(rules[2].elementAt(k));
inc(k);
end;
rules := nil;
end;
FreeandNil(enumItemSets);
inc(j);
end;
end;

procedure TDMApriori.buildModel(instances : TDMInstances);
var
confidences, supports : DArray;
indices : IArray;
necSupport : integer;
sortedRuleSet : TDMFastVectorArray;
i,j : integer;
sortType : integer;
curItemSets : TDMFastVector;
curItemSetsHashtables : TStringHashtable;
begin

setInstances(instances);

necSupport:=0;
SetLength(m_allTheRules,3);
SetLength(sortedRuleSet,3);

if (instances.checkForStringAttributes()) then
raise Exception.Create('Строковые атрибуты не поддерживаются');

// Decrease minimum support until desired number of rules found.
m_cycles := 0;
m_minSupport := m_upperBoundMinSupport - m_delta;

if m_minSupport < m_lowerBoundMinSupport then
m_minSupport := m_lowerBoundMinSupport;

// Reserve space for variables
m_Ls := TDMFastVector.Create();
m_hashtables := TDMFastVector.Create();
m_allTheRules[0] := TDMFastVector.Create();
m_allTheRules[1] := TDMFastVector.Create();
m_allTheRules[2] := TDMFastVector.Create();

sortedRuleSet[0] := TDMFastVector.Create();
sortedRuleSet[1] := TDMFastVector.Create();
sortedRuleSet[2] := TDMFastVector.Create();

repeat
begin
if (terminated) then
begin
ExitThread(1);
destroy;
end;
findLargeItemSets(instances);
findRulesQuickly();

SetLength(supports, m_allTheRules[2].size());

i := 0;
while (i < m_allTheRules[2].size()) do
begin
supports[i] := (m_allTheRules[1].elementAt(i) as TDMAprioriItemSet).support();
inc(i);
end;
indices := Utils.stableSort(supports);

i := 0;
while (i < m_allTheRules[2].size()) do
begin
sortedRuleSet[0].addElement(m_allTheRules[0].elementAt(indices[i]));
sortedRuleSet[1].addElement(m_allTheRules[1].elementAt(indices[i]));
sortedRuleSet[2].addElement(m_allTheRules[2].elementAt(indices[i]));
inc(i);
end;

// сортировка по достоверности
m_allTheRules[0].removeAllElements();
m_allTheRules[1].removeAllElements();
m_allTheRules[2].removeAllElements();

SetLength(confidences, sortedRuleSet[2].size());
sortType := 2 + m_metricType;

i := 0;
while (i < sortedRuleSet[2].size()) do
begin
confidences[i] := (sortedRuleSet[sortType].elementAt(i) as TDMDoubleObject).doubleValue();
inc(i);
end;
indices := Utils.stableSort(confidences);

i := sortedRuleSet[0].size() - 1;
while ( (i >= (sortedRuleSet[0].size() - m_numRules)) and (i >= 0)) do
begin
m_allTheRules[0].addElement(sortedRuleSet[0].elementAt(indices[i]));
m_allTheRules[1].addElement(sortedRuleSet[1].elementAt(indices[i]));
m_allTheRules[2].addElement(sortedRuleSet[2].elementAt(indices[i]));
dec(i);
end;

m_minSupport := m_minSupport - m_delta;

necSupport := trunc(m_minSupport * instances.numInstances()+0.5);
inc(m_cycles);

SetLength(confidences, 0);
SetLength(supports, 0);
SetLength(indices, 0);

if((m_allTheRules[0].size() < m_numRules)
and (Utils.grOrEq(m_minSupport, m_lowerBoundMinSupport))
and (necSupport >= 1)) then
begin
//удаление m_Ls
j := 0;
while (j < m_Ls.size()) do
begin
curItemSets := m_Ls.elementAt(j) as TDMFastVector;
curItemSets.removeAllElements();
inc(j);
end;
m_Ls.removeAllElements();

//удаление m_hashtables
j := 0;
while (j < m_hashtables.size()) do
begin
curItemSetsHashtables := m_hashtables.elementAt(j) as TStringHashtable;
curItemSetsHashtables.OwnValues := true;
FreeAndNil(curItemSetsHashtables);
inc(j);
end;
m_hashtables.removeAllElements();

//удаление правил
sortedRuleSet[0].removeAllElements();
sortedRuleSet[1].removeAllElements();
sortedRuleSet[2].removeAllElements();

m_allTheRules[0].removeAndClearAllElements();
m_allTheRules[1].removeAndClearAllElements();
m_allTheRules[2].removeAndClearAllElements();
end;
end
until not ((m_allTheRules[0].size() < m_numRules)
and (Utils.grOrEq(m_minSupport, m_lowerBoundMinSupport))
and (necSupport >= 1));

sortedRuleSet[0].removeAllElements();
sortedRuleSet[1].removeAllElements();
sortedRuleSet[2].removeAllElements();

FreeandNil( sortedRuleSet[0]);
FreeandNil( sortedRuleSet[1]);
FreeandNil( sortedRuleSet[2]);
SetLength(sortedRuleSet, 0);

m_minSupport := m_minSupport + m_delta;
end;

procedure TDMApriori.ClearModel();
var
j : integer;
curItemSets : TDMFastVector;
curItemSetsHashtables : TStringHashtable;
begin
if(m_Ls <> nil) then
begin
j := 0;
while (j < m_Ls.size()) do
begin
curItemSets := m_Ls.elementAt(j) as TDMFastVector;
curItemSets.removeAllElements();
inc(j);
end;
m_Ls.removeAllElements();
m_Ls := nil;
end;

if(m_hashtables <> nil) then
begin
j := 0;
while (j < m_hashtables.size()) do
begin
curItemSetsHashtables := m_hashtables.elementAt(j) as TStringHashtable;
curItemSetsHashtables.OwnValues := true;
FreeAndNil(curItemSetsHashtables);
inc(j);
end;
m_hashtables.removeAllElements();
m_hashtables := nil;
end;
end;

function TDMApriori.toString() : AnsiString;
var
text : AnsiString;
temp, temp1 : AnsiString;
i,j : integer;
val : double;
begin
text :='';
if (m_Ls.size() <= 1) then
begin
result := 'Не облнаружено наборов и правил';
exit;
end;
text := text + 'Apriori' +#10#13;
Str(m_minSupport:4:2,temp);
text := text + 'Минимальная поддержка: ' + temp + #10#13;
text := text + 'Минимальное значение метрики ';

text := text + 'достоверность: ';
Str(m_minMetric:4:2,temp);
text := text + temp +#10#13;
text := text + 'Найденные правила:' + #10#13;

i := 0;
while (i < m_allTheRules[0].size()) do
begin
val := i+1;
Str(val:round(ln(m_numRules)/ln(10)+1):2,temp);
Str((m_allTheRules[2].elementAt(i) as TDMDoubleObject).doubleValue:4:2,temp1);

text := text + temp + '. ' + (m_allTheRules[0].elementAt(i) as TDMAprioriItemSet).
toString(m_instances)
+ ' ==> ' + (m_allTheRules[1].elementAt(i) as TDMAprioriItemSet).
toString(m_instances) +' достоверность:('+ temp1 +')';

text := text + #10#13;
inc(i);
end;
result := text;
end;

function TDMApriori.toStrings() : TStrings;
var
text : TStrings;
strText : AnsiString;
temp, temp1 : AnsiString;
i,j : integer;
val : double;
begin
text := TStringList.Create;

text.Clear;
if (m_Ls.size() <= 1) then
begin
text.Add('Не облнаружено наборов и правил');
result := text;
exit;
end;
text.Add('Apriori');
text.Add('Данные: ' + inst.relationName);
Str(m_minSupport:4:2,temp);
text.Add('Минимальная поддержка: ' + temp);

strText:='';
strText := strText + 'Минимальное значение метрики ';
strText := strText + 'достоверность: ';
Str(m_minMetric:4:2,temp);

text.Add(strText + temp);

text.Add('Найденные правила:');

i := 0;
while (i < m_allTheRules[0].size()) do
begin
val := i+1;
Str(val:round(ln(m_numRules)/ln(10)+1):0,temp);
Str((m_allTheRules[2].elementAt(i) as TDMDoubleObject).doubleValue:4:2,temp1);

strText:='';
strText := strtext + temp + '. '
+ (m_allTheRules[0].elementAt(i) as TDMAprioriItemSet).
toString(m_instances)
+ ' ==> ' + (m_allTheRules[1].elementAt(i) as TDMAprioriItemSet).
toString(m_instances)
+' достоверность:('+ temp1 +')';
text.Add(strtext);
inc(i);
end;
result := text;
end;

destructor TDMApriori.Destroy();
var
i : integer;
begin

inherited destroy;

ClearModel();
FreeAndNil(m_instances);

//удаление правил
if(length(m_allTheRules)<>0)then
begin
m_allTheRules[0].removeAndClearAllElements();
m_allTheRules[1].removeAndClearAllElements();
m_allTheRules[2].removeAndClearAllElements();

FreeandNil(m_allTheRules[0]);
FreeandNil(m_allTheRules[1]);
FreeandNil(m_allTheRules[2]);

setlength(m_allTheRules,0);
end;

end;

end.