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

unit PriorEstimation;

interface
uses
Instances,
uContainers,
uConsts,
dmmTypes,
SpecialFunctions,
DoubleObject,
math,
ItemSet,
RuleItem,
SysUtils,
associator,
Windows;

const
//параметр используемый в качестве шага при генерации правил
SEED = 0;

//максимальное число атрибутов для которых может быть вычислена априорная точность
MAX_N = 1024;


type TDMPriorEstimation = class

protected
//число случайных правил
m_numRandRules : integer;

//число интервалов
m_numIntervals : integer;

//вектора
m_instances : TDMInstances ;

//поиск стандартных/для класса ассоциативных правил
m_CARs : boolean;

//хэш таблица хранит значений точности сгенерированных правил
m_distribution : TStringHashtable ;

//хэш таблица хранит значения априорных оценок
m_priors : TStringHashtable ;

//сумма достоверности правил заданной длины
m_sum : double;

//точка разбиения интервалов
m_midPoints : DArray;

public
constructor Create(instances : TDMInstances; numRules : integer; numIntervals : integer; car : boolean);
//оценка априорных вероятностей
function estimatePrior() : TStringHashtable;
function calculatePriorSum(weighted : boolean; mPoint : double ) : double;
procedure generateDistribution();
procedure midPoints();
function midPoint(size : double; number : integer) : double ;
//генерация случайного ассоциативного правила заданной длины
function randomRule(maxLength : integer; actualLength : integer) : IArray;
//разбаение набора на правую и левую часть
function splitItemSet (premiseLength : integer; itemArray : IArray) : TDMRuleItem;
//генерация наборов заданной длины
function randomCARule(maxLength : integer; actualLength : integer) : IArray;
function addCons (itemArray : IArray) : TDMRuleItem;
//пересчитать значение поддержки
procedure updateCounters(var itemSet : TDMItemSet );
//пересчитать распределение достоверности
procedure buildDistribution(conf : double; length : double);
function findIntervall(conf : double ) : double;
function getMidPoints() : DArray;
destructor Destroy; override;
end;
//log2 для биномиальных коэффициентов
function logbinomialCoefficient(upperIndex : integer; lowerIndex : integer) : double ;

implementation

constructor TDMPriorEstimation.Create(instances : TDMInstances; numRules : integer; numIntervals : integer; car : boolean);
begin
m_instances := TDMInstances.Create(instances);
m_CARs := car;
m_numRandRules := numRules;
m_numIntervals := numIntervals;
RandSeed := m_instances.getRandomNumberGenerator(SEED);
m_distribution := nil ;
m_priors := nil ;
m_midPoints := nil;
end;

function logbinomialCoefficient(upperIndex : integer; lowerIndex : integer) : double ;
var
curResult : double;
begin
cuRresult := 1.0;
if(upperIndex = lowerIndex) or (lowerIndex = 0) then
begin
result := curResult;
exit;
end;
curResult := SpecialFunctions.log2Binomial(upperIndex, lowerIndex);
result := curResult;
end;

procedure TDMPriorEstimation.midPoints();
var
i : integer;
begin
SetLength(m_midPoints,m_numIntervals);
i := 0;
while(i < m_numIntervals) do
begin
m_midPoints[i] := midPoint(1.0/m_numIntervals, i);
inc(i);
end;
end;

function TDMPriorEstimation.midPoint(size : double; number : integer) : double ;
begin
Result := (size * number) + (size / 2.0);
end;

function TDMPriorEstimation.randomRule(maxLength : integer; actualLength : integer) : IArray;
var
itemArray : IArray;
k,h : integer;
help : integer;
mark : integer;
begin
SetLEngth(itemArray,maxLength);
k := 0;
while (k < length(itemArray)) do
begin
itemArray[k] := -1;
inc(k);
end;

help := actualLength;
if(help = maxLength) then
begin
help := 0;
h := 0;
while(h < length(itemArray)) do
begin
itemArray[h] := randomRange(0,(m_instances.attribute(h)).numValues());
inc(h);
end;
end;
while(help > 0)do
begin
mark := randomRange(0,maxLength);
if(itemArray[mark] = -1) then
begin
dec(help);
itemArray[mark] := randomRAnge(0,(m_instances.attribute(mark)).numValues());
end;
end;
result := itemArray;
end;

function TDMPriorEstimation.splitItemSet (premiseLength : integer; itemArray : IArray) : TDMRuleItem;
var
cons : IArray;
i,help : integer;
mark : integer;
premise,consequence : TDMItemSet;
current : TDMRuleItem;
begin
SetLEngth(cons,m_instances.numAttributes());
cons :=Copy(itemArray, 0, length(itemArray));
help := premiseLength;
while(help > 0) do
begin
mark := randomRange(0,length(itemArray));
if(cons[mark] <> -1) then
begin
dec(help);
cons[mark] :=-1;
end;
end;

if(premiseLength = 0)then
begin
i := 0;
while(i < length(itemArray)) do
begin
itemArray[i] := -1;
inc(i);
end;
end else
begin
i := 0;
while(i < length(itemArray)) do
begin
if(cons[i] <> -1) then
itemArray[i] := -1;
inc(i);
end;
end;
premise := TDMItemSet.Create(itemArray);
consequence := TDMItemSet.Create(cons);
current := TDMRuleItem.Create(premise, consequence, true);

result := current;
end;

function TDMPriorEstimation.randomCARule(maxLength : integer; actualLength : integer) : IArray;
var
itemArray : IArray;
help : integer;
k, h : integer;
mark : integer;
begin
SetLength(itemArray,maxLength);
k := 0;
while(k < length(itemArray)) do
begin
itemArray[k] := -1;
inc(k);
end;
if(actualLength = 1) then
begin
result := itemArray;
exit;
end;

help := actualLength-1;
if(help = maxLength-1) then
begin
help := 0;
h := 0;
while(h < length(itemArray)) do
begin
if(h <> m_instances.classIndex()) then
itemArray[h] := randomRange(0, (m_instances.attribute(h)).numValues());
inc(h);
end;
end;
while(help > 0) do
begin
mark := randomRange(0,maxLength);
if(itemArray[mark] = -1) and (mark <> m_instances.classIndex()) then
begin
dec(help);
itemArray[mark] := randomRange(0,(m_instances.attribute(mark)).numValues());
end;
end;
result := itemArray;
end;

function TDMPriorEstimation.addCons (itemArray : IArray) : TDMRuleItem;
var
premise : TDMItemSet;
cons : IArray;
i : integer;
consequence : TDMItemSet;
current : TDMRuleItem;
begin
premise := TDMItemSet.Create(itemArray);
SetLength(cons,length(itemArray));

i := 0;
while(i < length(itemArray)) do
begin
cons[i] := -1;
inc(i);
end;
cons[m_instances.classIndex()] := randomRange(0,(m_instances.attribute(m_instances.classIndex())).numValues());
consequence := TDMItemSet.Create(cons);
current := TDMRuleItem.Create(premise,consequence, true);

result := current;
end;

procedure TDMPriorEstimation.updateCounters(var itemSet : TDMItemSet );
var
i : integer;
begin
i := 0;
while (i < m_instances.numInstances()) do
begin
itemSet.upDateCounter(m_instances.instance(i));
inc(i);
end;
end;

function TDMPriorEstimation.findIntervall(conf : double ) : double;
var
endInt : integer;
startInt : integer;
mid : integer;
begin
if(conf = 1.0) then
begin
result := m_midPoints[length(m_midPoints)-1];
exit;
end;
endInt := length(m_midPoints)-1;
startInt := 0;
while (abs(endInt-startInt) > 1) do
begin
mid := (startInt + endInt) div 2;
if (conf > m_midPoints[mid]) then
startInt := mid+1;
if (conf < m_midPoints[mid]) then
endInt := mid-1;
if(conf = m_midPoints[mid]) then
begin
result := m_midPoints[mid];
exit;
end;
end;
if(abs(conf-m_midPoints[startInt]) <= abs(conf-m_midPoints[endInt])) then
result := m_midPoints[startInt]
else
result := m_midPoints[endInt];
end;

procedure TDMPriorEstimation.buildDistribution(conf : double; length : double);
var
mPoint : double;
key : AnsiString;
mPointValue : AnsiString;
lengthValue : AnsiString;
curTDMDoubleObject : TDMDoubleObject;

begin
key :='';
mPoint := findIntervall(conf);
Str(mPoint:4:3,mPointValue);
Str(length:4:1,lengthValue);

key := mPointValue + lengthValue;
m_sum := m_sum + conf;

if m_distribution.Contains(key) then
begin
curTDMDoubleObject := m_distribution.Items[key];
if(curTDMDoubleObject <> nil) then
begin
conf := conf + curTDMDoubleObject.doubleValue();
end;
m_distribution.OwnValues := True;
m_distribution.remove(key);
m_distribution.OwnValues := false;
end;

m_distribution.Add(key,TDMDoubleObject.Create(conf));

end;


procedure TDMPriorEstimation.generateDistribution();
var
jump : boolean;
i,maxLength, count, ruleCounter : integer;
itemArray : IArray;
current : TDMRuleItem;

h,j,k,w : integer;
ruleItem : IArray;
rule : TDMItemSet;
key : AnsiString;
mPointVal : AnsiString;
iVal : AnsiString;
curTDMDoubleObject : TDMDoubleObject;
conf : double;
doublei : double;
begin
maxLength := m_instances.numAttributes();
count := 0;

m_distribution := TStringHashtable.Create(false,maxLength*m_numIntervals);

if(m_instances.numAttributes() = 0) then
raise Exception.Create('Нет атрибутов');
if(m_instances.numAttributes() >= MAX_N) then
raise Exception.Create('Слишком много аттрибутов для априорной оценки');
if(m_instances.numInstances() = 0) then
raise Exception.Create('Нет векторов');

h := 0;
while ( h < maxLength) do
begin
if (m_instances.attribute(h).isNumeric()) then
raise Exception.Create('Количественные атрибуты не поддерживаются');
inc(h);
end;
if(m_numIntervals = 0) or (m_numRandRules = 0) then
raise Exception.Create('Невозможна априорная инициализация');

midPoints();

//генерация случайных правил длиной i и вычисление поддержки;
//если поддержка >0 вычисляется достоверность

i := 1;
while(i <= maxLength) do
begin
if (terminated) then
begin
ExitThread(1);
destroy;
end;
m_sum := 0;
j := 0;
count := 0;

while(j < m_numRandRules) do
begin
inc(count);
jump := false;
if(not m_CARs) then
begin
itemArray := randomRule(maxLength,i);
current := splitItemSet(randomRange(0,i), itemArray);
end else
begin
itemArray := randomCARule(maxLength,i);
current := addCons(itemArray);
end;

SetLength(ruleItem,maxLength);

k := 0;
while (k < length(itemArray)) do
begin
if(current.m_premise.m_items[k] <> -1) then
ruleItem[k] := current.m_premise.m_items[k]
else
if(current.m_consequence.m_items[k] <> -1) then
ruleItem[k] := current.m_consequence.m_items[k]
else
ruleItem[k] := -1;
inc(k);
end;
rule := TDMItemSet.Create(ruleItem);
updateCounters(rule);
ruleCounter := rule.m_counter;
FreeandNil(rule);
if(ruleCounter > 0) then
jump := true;
updateCounters(current.m_premise);
inc(j);
if(jump) then
buildDistribution(ruleCounter/current.m_premise.m_counter,i);
current.OwnValues := true;
FreeandNil(current);
end;

//нормализация
if(m_sum > 0) then
begin
w := 0;
while ( w < length(m_midPoints)) do
begin
key :='';
Str(m_midPoints[w]:4:3,mPointVal);
doublei := i;
Str(doublei:4:1,iVal);

key := mPointVal + iVal;

if(m_distribution.Contains(key) = false )then
begin
m_distribution.Add(key,TDMDoubleObject.Create(1.0/m_numIntervals));
m_sum := m_sum + 1.0/m_numIntervals;
end;
inc(w);
end;

w := 0;
while (w < length(m_midPoints)) do
begin
conf := 0;
key :='';
Str(m_midPoints[w]:4:3,mPointVal);
doublei := i;
Str(doublei:4:1,iVal);
key := mPointVal + iVal;

if(m_distribution.Contains(key) = true) then
begin
curTDMDoubleObject := m_distribution.Items[key];
if (curTDMDoubleObject <> nil) then
begin
conf := curTDMDoubleObject.doubleValue / m_sum;
m_distribution.OwnValues := true;
m_distribution.remove(key);
m_distribution.OwnValues := false;
m_distribution.add(key,TDMDoubleObject.Create(conf));
end;
end;
inc(w);
end;
end else
begin
w := 0;
while(w < length(m_midPoints)) do
begin
key :='';
Str(m_midPoints[w]:4:3,mPointVal);
doublei := i;
Str(doublei:4:1,iVal);
key := mPointVal + iVal;
m_distribution.add(key,TDMDoubleObject.Create(1.0/m_numIntervals));
inc(w);
end;
end;
inc(i);
end;

end;

function TDMPriorEstimation.estimatePrior() : TStringHashtable;
var
prior, denominator, mPoint : double;
m_priors : TStringHashtable;
i : integer;
mPointVal : AnsiString;
j : integer;

begin
m_priors := TStringHashtable.Create(false,m_numIntervals);
denominator := calculatePriorSum(false,1.0);
generateDistribution();

i := 0;
while(i < m_numIntervals) do
begin
mPoint := m_midPoints[i];
prior := calculatePriorSum(true,mPoint) / denominator;
Str(mPoint,mPointVal);
m_priors.add(mPointVAl, TDMDoubleObject.Create(prior));
inc(i);
end;
result := m_priors;
end;

function TDMPriorEstimation.calculatePriorSum(weighted : boolean; mPoint : double ) : double;
var
distr, sum, max : double;
i : integer;
key : AnsiString;
mPointValue : ansiString;
iValue : AnsiString;
curTDMDoubleObject : TDMDoubleObject;
addend : double;
doublei : double;
begin
sum := 0;
max := logbinomialCoefficient(m_instances.numAttributes(),trunc(m_instances.numAttributes()/2));

i := 1;
while(i <= m_instances.numAttributes()) do
begin
if(weighted) then
begin
key := '';
Str(mPoint:4:3,mPointValue);
doublei := i;
Str(doublei:4:1,iValue);

key := mPointValue + iValue;
curTDMDoubleObject := m_distribution.Items[key];

if(curTDMDoubleObject <> nil) then
begin
distr := curTDMDoubleObject.doubleValue;
end
else
distr := 0;
if(distr <> 0) then
begin
addend := log2(distr) - max + log2((power(2,i)-1)) + logbinomialCoefficient(m_instances.numAttributes(),i);
sum := sum + power(2,addend);
end;
end else
begin
addend := log2((power(2,i)-1)) - max + logbinomialCoefficient(m_instances.numAttributes(),i);
sum := sum + power(2,addend);
end;
inc(i);
end;
result := sum;
end;

function TDMPriorEstimation.getMidPoints() : DArray;
begin
result := m_midPoints;
end;

destructor TDMPriorEstimation.Destroy;
begin
FreeAndNil(m_instances);

m_distribution.OwnValues := true;
FreeAndNil(m_distribution);

FreeAndNil(m_priors) ;

m_midPoints := nil;
end;
end.