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

unit RuleGeneration;

interface
uses
Instances,
dmmTypes,
dmmConstants,
uContainers,
ItemSet,
FastVector,
RuleItem,
DoubleObject,
math,
PriorEstimation,
Statistics,
SysUtils,
uConsts;

const
MAX_N = 300;

type
TDMRuleGeneration = class (TObject)
public
//набор
m_items : IArray;

//число векторов содержащих данный набора
m_counter : integer;

//общее количество векторов
m_totalTransactions : integer;

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

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

//минимальная требуемая поддержка набора для попадания в список лучших
m_minRuleCount : integer;

m_midPoints : DArray;

m_priors : TStringHashtable;

//список лучших правил
m_best : TArrayList;

m_count : integer;

m_instances : TDMInstances ;

m_OwnValues : boolean;

public
constructor Create(itemSet : TDMItemSet);
property OwnValues: Boolean read m_OwnValues write m_OwnValues;
function generateRules(numRules : integer; midPoints : DArray; priors : TStringHashtable; curExpectation : double; instances : TDMInstances; var best : TArrayList; genTime : integer) : TArrayList;
procedure singleConsequence(instances : TDMInstances; attNum : integer; var consequences : TDMFastVector );
function removeRedundantRuleItem(toInsert : TDMRuleItem) : boolean;
function aSubsumesB( a : TDMRuleItem; b : TDMRuleItem ) : boolean ;

function compareRuleItem (Item: Pointer): Integer;
destructor Destroy; override;

end;
//ожидаемая точность предсказанияя
function expectation(ruleCount : double; premiseCount : integer; midPoints : DArray; priors : TStringHashtable ) : double;
function binomialDistribution(accuracy : double; ruleCount : double; premiseCount : double) : double;
function generateRuleItem(premise : TDMItemSet; consequence : TDMItemSet; instances : TDMInstances ; genTime : integer; minRuleCount : integer; m_midPoints : DArray; m_priors : TStringHashtable): TDMRuleItem;
procedure SetRuleItemAccuracy (var ruleItem : TDMRuleItem; ruleSupport : integer; premise : TDMItemSet;m_midPoints : DArray; m_priors : TStringHashtable);
function equalRuleItem (Value, Item: Pointer): Integer;
function tocompareRuleItem (Value,Item: Pointer): Integer;

implementation
constructor TDMRuleGeneration.Create(itemSet : TDMItemSet);
begin
m_totalTransactions := itemSet.m_totalTransactions;
m_counter := itemSet.m_counter;
m_items := itemSet.m_items;
m_change := false;
m_midPoints :=nil;
m_priors := nil;
m_best := nil;
m_instances := nil;
m_OwnValues := false;
end;

procedure SetRuleItemAccuracy (var ruleItem : TDMRuleItem; ruleSupport : integer; premise : TDMItemSet;m_midPoints : DArray; m_priors : TStringHashtable);
begin
ruleItem.m_accuracy := RuleGeneration.expectation(ruleSupport,premise.m_counter,m_midPoints,m_priors);
if(isNaN(ruleItem.m_accuracy)) or (ruleItem.m_accuracy < 0) then
begin
ruleItem.m_accuracy := MIN_VALUE;
end;
end;

function TDMRuleGeneration.aSubsumesB(a : TDMRuleItem; b : TDMRuleItem ) : boolean ;
var
k : integer;
begin
if(a.m_accuracy < b.m_accuracy) then
begin
result := false;
exit;
end;

k := 0;
while (k < length(a.premise().m_items)) do
begin
if(a.premise().m_items[k] <> b.premise().m_items[k]) then
begin
if( ( ((a.premise().m_items[k]) <> -1) and (b.premise().m_items[k] <> -1)) or (b.premise().m_items[k] = -1)) then
begin
result := false;
exit;
end;
end;
if(a.consequence().m_items[k] <> b.consequence().m_items[k]) then
begin
if(((a.consequence().m_items[k] <> -1) and (b.consequence().m_items[k] <> -1)) or (a.consequence().m_items[k] = -1)) then
begin
result := false;
exit;
end;
end;
inc(k);
end;
result := true;

end;

function generateRuleItem(premise : TDMItemSet; consequence : TDMItemSet; instances : TDMInstances ; genTime : integer; minRuleCount : integer; m_midPoints : DArray; m_priors : TStringHashtable): TDMRuleItem;
var
rule : TDMItemSet;
i,k : integer;
ruleSupport : integer;
newRule : TDMRuleItem;
newpremise : TDMItemSet;
begin
rule := TDMItemSet.Create(instances.numInstances());
SetLength(rule.m_items, length(consequence.m_items));;
rule.m_items := Copy(premise.m_items, 0, length(premise.m_items));

newpremise := TDMItemSet.Create;
newpremise.m_totalTransactions := premise.m_totalTransactions;
newpremise.m_id := premise.m_id;
newpremise.m_items := premise.m_items;
newpremise.m_counter := premise.m_counter;

k := 0;
while (k < length(consequence.m_items))do
begin
if(consequence.m_items[k] <> -1) then
rule.m_items[k] := consequence.m_items[k];
inc(k);
end;

i := 0;
while (i < instances.numInstances()) do
begin
rule.upDateCounter(instances.instance(i));
inc(i);
end;

ruleSupport := rule.support();
if(ruleSupport > minRuleCount) then
begin
newRule := TDMRuleItem.Create(newpremise,consequence,genTime,ruleSupport);
SetRuleItemAccuracy(newRule, ruleSupport,newpremise,m_midPoints,m_priors);
FreeAndNil(rule);
result := newRule;
exit;
end;
FreeAndNil(rule);
FreeAndNil(newpremise);
result := nil;
end;

function binomialDistribution(accuracy : double; ruleCount : double; premiseCount : double) : double;
var
mu, sigma : double;
begin
if(premiseCount < MAX_N) then
begin
result := power(2,(log2(power(accuracy,ruleCount))+
log2(power((1.0-accuracy),(premiseCount-ruleCount)))+
PriorEstimation.logbinomialCoefficient(trunc(premiseCount),trunc(ruleCount))));
end
else
begin
mu := premiseCount * accuracy;
sigma := sqrt((premiseCount * (1.0 - accuracy))*accuracy);
result := Statistics.normalProbability(((ruleCount+0.5)-mu)/(sigma*sqrt(2)));
end;
end;

function expectation(ruleCount : double; premiseCount : integer; midPoints : DArray; priors : TStringHashtable ) : double;
var
numerator,denominator : double;
i : integer;
actualPrior : double;
midPointValue : AnsiString;
curTDMDoubleObject : TDMDoubleObject;
addend : double;
help : AnsiString;
begin
numerator := 0;
denominator := 0;

i := 0;
while (i < length(midPoints)) do
begin
Str(midPoints[i], midPointValue);
curTDMDoubleObject := priors.Items[midPointValue];
if(curTDMDoubleObject <> nil) then
begin
actualPrior := curTDMDoubleObject.doubleValue;
if(actualPrior <> 0) then
begin
addend := actualPrior * binomialDistribution(midPoints[i], ruleCount, premiseCount);
denominator := denominator + addend;
numerator := numerator + addend*midPoints[i];
end;
end;
inc(i);
end;
if(denominator <= 0) or (isNaN(denominator)) then
begin
Str(denominator:4:2, help);
raise Exception.Create('Значение denominator: '+ help);
end;
if(numerator <= 0) or (isNaN(numerator)) then
begin
Str(numerator:4:2, help);
raise Exception.Create( 'Значение numerator: '+ help);
end;
result := numerator/denominator;
end;

procedure TDMRuleGeneration.singleConsequence(instances : TDMInstances; attNum : integer; var consequences : TDMFastVector );
var
consequence : TDMItemSet;
i,j,k : integer;
begin
i := 0;
while (i < instances.numAttributes()) do
begin
if( i = attNum) then
begin
j := 0;
while ( j < instances.attribute(i).numValues()) do
begin
consequence := TDMItemSet.Create(instances.numInstances());
SetLength(consequence.m_items,instances.numAttributes());
k := 0;
while ( k < instances.numAttributes()) do
begin
consequence.m_items[k] := -1;
inc(k);
end;
consequence.m_items[i] := j;
consequences.addElement(consequence);
inc(j);
end;
end;
inc(i);
end;

end;

function equalRuleItem (Value, Item: Pointer): Integer;
var
itemSet : TDMRuleItem;
itemSetToCompare : TDMRuleItem;
PDMRuleItem : ^TDMRuleItem;
begin
PDMRuleItem := Value;
itemSet := PDMRuleItem^ ;
PDMRuleItem := Item;
itemSetToCompare := PDMRuleItem^;
if (itemSet.equals(itemSetToCompare)) then
result := 0
else
result := -1;
end;


function TDMRuleGeneration.removeRedundantRuleItem(toInsert : TDMRuleItem) : boolean;
var
redundant, fSubsumesT, tSubsumesF : boolean;
first : TDMRuleItem;
subsumes : integer;
i : integer;
plist : PPointerItemList;
list : TPointerItemList;
remove : boolean;
index : integer;
best : TArrayList;

begin

redundant := false;
fSubsumesT := false;
tSubsumesF := false;

subsumes := 0;
plist := m_best.ItemList;
i:=0;
while (i < m_best.Count) do
begin
first := plist^[i];
fSubsumesT := aSubsumesB(first,toInsert);
tSubsumesF := aSubsumesB(toInsert, first);
if(fSubsumesT) then
begin
subsumes := 1;
break;
end
else
begin
if(tSubsumesF) then
begin
m_best.OwnItems := true;
first.m_premise.OwnValues := false;
first.m_OwnValues := true;
m_best.removeAt(i);
m_best.OwnItems :=false;
dec(i);
subsumes := 2;
redundant := true;
end;
end;
inc(i);
end;
if(subsumes = 0) or (subsumes = 2) then
begin
if (compareRuleItem(toInsert)<> 0) then
begin
m_best.add(toInsert);
m_best.Sort(toCompareRuleItem);
end;
end;
result := redundant;
end;

function TDMRuleGeneration.generateRules(numRules : integer; midPoints : DArray;
priors : TStringHashtable; curExpectation : double;
instances : TDMInstances; var best : TArrayList;
genTime : integer) : TArrayList;
var
redundant : boolean;
consequences,consequencesMinusOne : TDMFastVector;
premise : TDMItemSet;
s : integer;
current, old : TDMRuleItem;
hashtable : TStringHashtable ;
i, j, h,k : integer;
allRuleItems : TDMFastVector;
index : integer;
dummie : TDMRuleItem;
remove : boolean;
firstBest : TDMRuleItem;
plist : PPointerItemList;
itemToRemove : TDMItemSet;
reserved : boolean;

ii ,hh: integer;
rlSet:TDMRuleItem;

itSetc:TDMItemSet;
itsP :IArray;
itsC :IArray;
rF: TextFile;
begin

redundant := false;

consequences := TDMFastVector.Create();
consequencesMinusOne := nil;

reserved :=false;
s := 0;
current := nil;

m_change := false;
m_midPoints := midPoints;
m_priors := priors;
m_best := best;
m_expectation := curExpectation;
m_count := genTime;
m_instances := instances;

premise := nil;
premise := TDMItemSet.Create(m_totalTransactions);
premise.m_items := m_items;
premise.m_counter := m_counter;

repeat
begin
m_minRuleCount := 1;
while (expectation(m_minRuleCount, premise.m_counter, m_midPoints, m_priors) <= m_expectation) do
begin
inc(m_minRuleCount);
if(m_minRuleCount > premise.m_counter) then
begin
consequences.elementMemoryManagement(false);
FreeAndNil(consequences);
best:=nil;
result := m_best;
exit;
end;
end;
redundant := false;

i := 0;
while (i < instances.numAttributes()) do
begin
if(i = 0) then
begin
j := 0;
while(j < length(m_items)) do
begin
if(m_items[j] = -1) then
singleConsequence(instances, j,consequences);
inc(j);
end;
if(premise = nil) or (consequences.size() = 0) then
begin
result := m_best;
consequences.elementMemoryManagement(false);
FreeAndNil(consequences);
best:=nil;
exit;
end;
end;
allRuleItems := TDMFastVector.Create();
index := 0;
repeat
begin
h := 0;
while(h < consequences.size()) do
begin
current := generateRuleItem(premise,consequences.elementAt(h) as TDMItemSet,instances,m_count,m_minRuleCount,m_midPoints,m_priors);
if(current <> nil)then
begin
allRuleItems.addElement(current);
inc(h);
end else
consequences.removeAndClearElementAt(h);
end;

if(index = i) then
begin
consequences := consequences.copyObject() as TDMFastVector;
break;
end;

consequencesMinusOne := consequences;
consequences := ItemSet.mergeAllItemSets(consequencesMinusOne, index, instances.numInstances());
hashtable := ItemSet.getHashtable(consequencesMinusOne, consequencesMinusOne.size());
consequences := ItemSet.pruneItemSets(consequences, hashtable);
FreeAndNil(hashtable);

inc(index);
end;
until not (consequences.size() > 0);

h := 0;
while (h < allRuleItems.size())do
begin
current := allRuleItems.elementAt(h) as TDMRuleItem;
inc(m_count);
if(m_best.Count < numRules) then
begin
m_change := true;
redundant:=removeRedundantRuleItem(current);
end
else
begin
if(current.accuracy() > m_expectation) then
begin
plist := m_best.ItemList;
firstBest := plist^[0];
m_expectation := firstBest.accuracy();
m_best.OwnItems := true;

firstBest.m_OwnValues := true;
m_best.removeAt(0);
m_best.OwnItems := false;
m_change := true;
redundant:=removeRedundantRuleItem(current);

plist := m_best.ItemList;
firstBest := plist^[0];
m_expectation := firstBest.accuracy();
while(expectation(m_minRuleCount,(current.premise()).m_counter,m_midPoints,m_priors) < m_expectation)do
begin
inc(m_minRuleCount);
if(m_minRuleCount > (current.premise()).m_counter) then
break;
end;
end
else
begin

current.m_OwnValues := true;
FreeAndNil(current);
end;
end ;
inc(h);
end;
inc(i);
allRuleItems.elementMemoryManagement(false);
FreeAndNil(allRuleItems);

end;
end;
until (not redundant);

FreeAndNil(premise);
consequences.elementMemoryManagement(false);
FreeAndNil(consequences);
best:=nil;
result := m_best;
end;


function TDMRuleGeneration.compareRuleItem (Item: Pointer): Integer;
var
i : integer;
plist : PPointerItemList;


itemSet : TDMRuleItem;
itemSetToCompare : TDMRuleItem;
PTDMRuleItem : ^TDMRuleItem;
curResult : integer;
begin

i := 0;
plist := m_best.ItemList;

result := -1;

while (i < m_best.Count) do
begin
itemSet := plist^[i];

result := itemSet.compareTo(item);
if (result = 0) then
exit;
inc(i);
end;


end;

function tocompareRuleItem (Value,Item: Pointer): Integer;
var

itemSet : TDMRuleItem;
itemSetToCompare : TDMRuleItem;
PTDMRuleItem : ^TDMRuleItem;
begin

PTDMRuleItem := Item;
itemSetToCompare := PTDMRuleItem^;


itemSet := value;

result := (itemSet as TDMRuleItem).compareTo(item);

end;

destructor TDMRuleGeneration.Destroy;
begin
if(m_OwnValues)then
begin
FreeAndNil(m_items);
m_midPoints :=nil;
end;
m_priors := nil;
m_best := nil;
m_instances:=nil;
end;
end.