Implementation
constructor TDMPredictiveApriori.Create(i1:integer);
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(i1);
end;
procedure TDMPredictiveApriori.resetOptions(i1:integer);
begin
// m_numRules := i1;
m_numRules := 1000;
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.toStrings(instances : TDMInstances;
Podd : real; Toch : real;
number : integer) : TStrings;
var
strtext : AnsiString;
text : TStrings;
i : integer;
tochn : AnsiString;
podder : String;
TochnReal : real;
PodderReal : real;
val : integer;
begin
text := TStringList.Create;
text.Clear;
if (m_allTheRules[0].size() = 0) then
begin
text.Add('наборы не найдены');
result:=text;
exit;
end;
text.Add(' Apriori');
text.Add('==========');
i := 0;
val := 1;
while ((i < m_allTheRules[0].size()) and (val<=number)) do
begin
Str((((m_allTheRules[1].elementAt(i)) as TDMItemSet).m_counter
/instances.numInstances) : 4 : 5, podder);
PodderReal:=(((m_allTheRules[1].elementAt(i)) as TDMItemSet).m_counter
/instances.numInstances);
Str(((m_allTheRules[2].elementAt(i) as TDMDoubleObject).doubleValue) :4 : 4, tochn);
TochnReal:=((m_allTheRules[2].elementAt(i) as TDMDoubleObject).doubleValue);
if ((TochnReal >= Toch) and (PodderReal >= Podd)) then
begin
strtext:='';
strtext := IntToStr(val)+')' + ' . ' + ((m_allTheRules[0].elementAt(i)) as TDMItemSet).
toString(m_instances) + ' ==> ' + ((m_allTheRules[1].elementAt(i)) as TDMItemSet).
toString(m_instances) +' точность:(';
text.Add(strtext + tochn+')');
text.Add(' поддержка ' + podder);
inc(val);
end;
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.