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

unit PredictiveApriori;

interface
uses
Classes,
FastVector,
Instances,
uContainers,
dmmTypes,
PriorEstimation,
SysUtils,
ItemSet,
dmmConstants,
RuleGeneration,
RuleItem,
DoubleObject,
uConsts,
associator,
dmm,
Windows;
const
//количество правил для вычисления априорной оценки
m_numRandRules = 100;

//количество интервалов для вычисления априорной оценки
m_numIntervals = 10;

type TDMPredictiveApriori = class (TDMAssociator)

protected
//минимальная поддержка
m_premiseCount : integer;

//требуемое количество правил
m_numRules : integer;

//наборы
m_Ls : TDMFastVector;

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

//набор правил
m_allTheRules : TDMFastVectorArray;

//вектора на основе которых генерируются правила
m_instances : TDMInstances ;

//хэш таблица с априорными вероятностями
m_priors : TStringHashtable ;

//середина интервалов для оаприорной оценки
m_midPoints : DArray;

//требуемое значение точности для 'выходного' правила
m_expectation : double;

//n лучших правил
m_best : TArrayList;

//изменился ли набор из n лучших правил
m_bestChanged : boolean;

m_count : integer;

//априорная оценка
m_priorEstimator : TDMPriorEstimation;

public
constructor Create();
procedure buildModel(instances : TDMInstances ); override;
function toString() : AnsiString;
function toStrings() : TStrings; override;
procedure setNumRules(v : integer);
procedure resetOptions();
destructor Destroy;override;

private
procedure findLargeItemSets(index : integer);
procedure findRulesQuickly();
end;


implementation

constructor TDMPredictiveApriori.Create();
begin
m_Ls:=nil;
m_hashtables:=nil;
m_allTheRules := nil;
m_instances:=nil;
m_priors:=nil ;
m_midPoints :=nil;
m_best:=nil;
m_best:=nil;
resetOptions();
end;

procedure TDMPredictiveApriori.resetOptions();
begin
m_numRules := 105;
m_premiseCount := 1;
m_best := TArrayList.Create(m_numRules-5);
m_bestChanged := false;
m_expectation := 0;
m_count := 1;
end;

procedure TDMPredictiveApriori.findLargeItemSets(index : integer);
var
kMinusOneSets, kSets : TDMFastVector;
hashtable : TStringHashtable;
currentItemSets : TDMFastVector;
i,j : integer;
begin
kSets := TDMFastVector.Create();
i := 0;
//наборы длины 1
if(index = 1) then
begin
kSets := ItemSet.getSingletons(m_instances);
ItemSet.upDateCounters(kSets, m_instances);
kSets := ItemSet.deleteItemSets(kSets, m_premiseCount,IMAX_VALUE);
if (kSets.size() = 0) then
begin
FreeAndNil(kSets);
exit;
end;

m_Ls.addElement(kSets);
end;
//длина > 1
if(index >1) then
begin

if(m_Ls.size() > 0) then
kSets := m_Ls.lastElement() as TDMFastVector;
m_Ls.removeAllElements();
i := index-2;

kMinusOneSets := kSets;
kSets := ItemSet.mergeAllItemSets(kMinusOneSets, i, m_instances.numInstances());
hashtable := ItemSet.getHashtable(kMinusOneSets, kMinusOneSets.size());
kMinusOneSets.elementMemoryManagement(false);
FreeAndNil(kMinusOneSets);
m_hashtables.addElement(hashtable);
kSets := ItemSet.pruneItemSets(kSets, hashtable);

ItemSet.upDateCounters(kSets, m_instances);
kSets := ItemSet.deleteItemSets(kSets, m_premiseCount,IMAX_VALUE);

if(kSets.size() = 0) then
begin
FreeAnDNil(kSets);
exit;
end;

m_Ls.addElement(kSets);

end;
end;

procedure TDMPredictiveApriori.findRulesQuickly();
var
rules : TDMFastVectorArray;
currentItemSet : TDMRuleGeneration;
j : integer;
currentItemSets : TDMFastVector;
enumItemSets : TDMFastVectorEnumeration;
bestFirst : TDMRuleItem;
PTDMRuleItem : ^TDMRuleItem;
plist : PPointerItemList;

begin
j := 0;
while (j < m_Ls.size()) do
begin


currentItemSets := m_Ls.elementAt(j) as TDMFastVector;
enumItemSets := TDMFastVectorEnumeration.Create(currentItemSets);
while (enumItemSets.hasMoreElements()) do
begin
if (terminated) then
begin
ExitThread(1);
destroy;
end;
currentItemSet := TDMRuleGeneration.Create(enumItemSets.nextElement()as TDMItemSet);

m_best := currentItemSet.generateRules(m_numRules, m_midPoints,m_priors,m_expectation,
m_instances,m_best,m_count);
m_count := currentItemSet.m_count;
if(not m_bestChanged) and (currentItemSet.m_change) then
m_bestChanged := true;
if(m_best.Count > 0) then
begin
plist := m_best.ItemList;
bestFirst:= plist^[0];
m_expectation := (bestFirst).accuracy();
end
else m_expectation := 0;
FreeAndNil(currentItemSet);
end;
FreeAndNil(enumItemSets);
inc(j);
end;
end;


procedure TDMPredictiveApriori.buildModel(instances : TDMInstances );
var
temp,exactNumber : integer;
i,k : integer;
PTDMRuleItem : ^TDMRuleItem;
lastBest : TDMRuleItem;
kSets : TDMFastVector;
plist : PPointerItemList;

begin
temp := m_premiseCount;
exactNumber := m_numRules-5;

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

m_instances := TDMInstances.Create(instances);
m_instances.setClassIndex(m_instances.numAttributes()-1);
//априорная оценка
m_priorEstimator := TDMPriorEstimation.Create(m_instances,m_numRandRules,m_numIntervals,false);
m_priors := m_priorEstimator.estimatePrior();
m_midPoints := m_priorEstimator.getMidPoints();

m_Ls := TDMFastVector.Create();
m_hashtables := TDMFastVector.Create();

i := 1;
while (i < m_instances.numAttributes()) do
begin
m_bestChanged := false;
if (terminated) then
begin
ExitThread(1);
destroy;
end;
// поиск наборов
findLargeItemSets(i);

findRulesQuickly();

if(m_bestChanged) then
begin
temp := m_premiseCount;
while(RuleGeneration.expectation(m_premiseCount, m_premiseCount,m_midPoints,m_priors) <= m_expectation) do
begin
inc(m_premiseCount);
if(m_premiseCount > m_instances.numInstances()) then
break;
end;
end;
if(m_premiseCount > m_instances.numInstances()) then
begin
SetLength(m_allTheRules,3);
m_allTheRules[0] := TDMFastVector.Create();
m_allTheRules[1] := TDMFastVector.Create();
m_allTheRules[2] := TDMFastVector.Create();

k := 0;
while(m_best.count>0) and (exactNumber > 0) do
begin
plist := m_best.itemList;
PTDMRuleItem := plist^[m_best.Count-1];
lastBest := PTDMRuleItem^;
m_allTheRules[0].insertElementAt(lastBest.premise()as TDMItemSet,k);
m_allTheRules[1].insertElementAt(lastBest.consequence() as TDMItemSet,k);
m_allTheRules[2].insertElementAt(TDMDoubleObject.Create(lastBest.accuracy()),k);
m_best.removeAt(m_best.count-1);
inc(k);
dec(exactNumber);
lastBest.OwnValuesCons := false;
FreeAndNil(lastBest);
end;
exit;
end;

if(temp <> m_premiseCount) and (m_Ls.size() > 0) then
begin
kSets := m_Ls.lastElement() as TDMFastVector;
m_Ls.removeElementAt(m_Ls.size()-1);
kSets := ItemSet.deleteItemSets(kSets, m_premiseCount,IMAX_VALUE);
m_Ls.addElement(kSets);
end;
inc(i);
end;

SetLength(m_allTheRules,3);
m_allTheRules[0] := TDMFastVector.Create();
m_allTheRules[1] := TDMFastVector.Create();
m_allTheRules[2] := TDMFastVector.Create();

k := 0;
while(m_best.count>0) and (exactNumber > 0) do
begin
plist := m_best.itemList;
lastBest:= plist^[m_best.Count-1];

m_allTheRules[0].insertElementAt(lastBest.premise() as TDMItemSet,k);
m_allTheRules[1].insertElementAt(lastBest.consequence() as TDMItemSet,k);
m_allTheRules[2].insertElementAt(TDMDoubleObject.Create(lastBest.accuracy()),k);
m_best.removeAt(m_best.count-1);
inc(k);
dec(exactNumber);
lastBest.OwnValuesCons := false;
FreeAndNil(lastBest);
end;
end;

function TDMPredictiveApriori.toString() : AnsiString;
var
text : AnsiString;
i : integer;
temp : AnsiString;
val : double;
begin
if (m_allTheRules[0].size() = 0) then
begin
result := 'наборы не найдены';
exit;
end;
text:= text + ('PredictiveApriori') + #10#13;
text := text + ('Найденные правила:') + #10#13;

i := 0;
while (i < m_allTheRules[0].size()) do
begin
val := i+1;
Str(val : trunc(ln(m_numRules)/ln(10) + 1): 0, temp);
text := text + temp + ' . ' + ((m_allTheRules[0].elementAt(i)) as TDMItemSet).
toString(m_instances) + ' ==> ' + ((m_allTheRules[1].elementAt(i)) as TDMItemSet).
toString(m_instances) +' точность:(';
Str((m_allTheRules[2].elementAt(i) as TDMDoubleObject).doubleValue : 4: 5, temp);
text := text + temp+')' + #10#13;
inc(i);
end;
result := text;
end;

function TDMPredictiveApriori.toStrings() : TStrings;
var
strtext : AnsiString;
text : TStrings;
i : integer;
temp : AnsiString;
val : double;

begin
text := TStringList.Create;
text.Clear;
if (m_allTheRules[0].size() = 0) then
begin
text.Add('наборы не найдены');
result:=text;
exit;
end;
text.Add('PredictiveApriori');
text.Add('===================');
text.Add('Данные: ' + inst.relationName);
text.Add('n лучших правил');

i := 0;
while (i < m_allTheRules[0].size()) do
begin
val := i+1;
Str(val : trunc(ln(m_numRules)/ln(10) + 1): 0, temp);
strtext:='';
strtext := temp + ' . ' + ((m_allTheRules[0].elementAt(i)) as TDMItemSet).
toString(m_instances) + ' ==> ' + ((m_allTheRules[1].elementAt(i)) as TDMItemSet).
toString(m_instances) +' точность:(';
Str((m_allTheRules[2].elementAt(i) as TDMDoubleObject).doubleValue : 4: 5, temp);
text.Add(strtext + temp+')');
inc(i);
end;
result := text;
end;

procedure TDMPredictiveApriori.setNumRules(v : integer);
begin
m_numRules := v+5;
end;

destructor TDMPredictiveApriori.Destroy;
var i,j :integer;
first :TDMItemSet;
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;
FreeAndNil(m_instances);
//удаление правил
if(length(m_allTheRules)<>0)then
begin
for i:=0 to m_allTheRules[0].size - 1 do
begin
first := m_allTheRules[0].elementAt(i) as TDMItemSet;
first.OwnValues := true;
end;
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;


m_priors.OwnValues:=true;
FreeAndNil(m_priors);
FreeAndNil(m_best);
FreeAndNil(m_priorEstimator);
m_midPoints :=nil;

end;
end.