Курсовой проект групп 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.