R/X_1Point_VIM2.R

In NHEMOtree: Non-hierarchical evolutionary multi-objective tree learner to perform cost-sensitive classification

X_1Point_VIM2 <-
function(E1, E2, VIM, Max_Knoten, Daten, CV_Laeufe, N_Varis, uS, oS){

  # Korrekte Nummerierung der ZHT-Spalteneintraege
    E1<- Werte_Reduktion_ZHT2(E1)
    E2<- Werte_Reduktion_ZHT2(E2)

  # Zwei Wurzelbaeume --> Keine Rekombination
    if (E1$Knoten==1 && E2$Knoten==1) return(list(E1, E2))

  # Ein Wurzelbaum   --> X_1Point_GP_WK
    if (E1$Knoten==1 || E2$Knoten==1) return(X_1Point_GP_WK(E1=E1, E2=E2))

  # Bestimmen der TIEFE der einzelnen KNOTEN:
    E1        <- Baumtiefe(Tree=E1)
    E2        <- Baumtiefe(Tree=E2)
    Max_Tiefe1<- max(E1$Zusammenhangstabelle[,4])
    Max_Tiefe2<- max(E2$Zusammenhangstabelle[,4])

  # Der Baum mit der geringen Tiefe wird 1. Elternbaum
    if (Max_Tiefe1>Max_Tiefe2){
        E2_temp<- E1
        E1     <- E2
        E2     <- E2_temp
    }
    ZHT1<- E1$Zusammenhangstabelle
    ZHT2<- E2$Zusammenhangstabelle

  #################
  # 1. Elternbaum #
  #################
  # Auswahl des Rekombinationspunktes (ausser Wurzelknoten)
    KC1   <- WK_Auswahl_Rang(Tree=E1, VIM=VIM, N_Varis=N_Varis)
    KC1[2]<- 0  
    KC1_Tiefe<- ZHT1[which(ZHT1[,1]==KC1[1])[1],4]

  # Suche Sohn- und Enkelknoten der Subtrees
    Links_1 <- ZHT1[which(ZHT1[,2]==0),]
    Rechts_1<- ZHT1[which(ZHT1[,2]==1),]
    i<- 1; j<-1
    while (j<=length(KC1)){
      if (KC1[j]!=-99){
          KC1[i+1]<- Links_1[which(Links_1[,1]==KC1[j]),3]
          KC1[i+2]<- Rechts_1[which(Rechts_1[,1]==KC1[j]),3]
          i       <- i+2
      }
      j<- j+1
    }

  # Alle zu loeschenden Vaterknoten ohne "-99" Eintraege
    KC1<- sort(KC1)
    while (KC1[1]<0) KC1<- KC1[-1]

  # Extrahieren der Subtrees und Loeschen der Subtrees aus den Eltern-ZHT:
    temp1a<- c(); temp1b<- c()
    for (i in 1:length(KC1)){
         temp1a<- c(temp1a, which(ZHT1[,1]==KC1[i]))
         temp1b<- c(temp1b, which(E1$Varis[,1]==KC1[i]))
    }

    ZHT1_kurz          <- ZHT1[-temp1a,]
    Varis1_kurz        <- matrix(E1$Varis[-temp1b,], ncol=2)
    CO1_kurz           <- matrix(E1$CO[-temp1b,], ncol=2)
    ZHT1_Subtree_sauber<- ZHT1_Subtree<- ZHT1[temp1a,]
    Varis1_Subtree     <- matrix(E1$Varis[temp1b,], ncol=2)
    CO1_Subtree        <- matrix(E1$CO[temp1b,], ncol=2)


  #################
  # 2. Elternbaum #
  #################
  # Auswahl der Rekombinationspunkte (ausser Wurzelknoten):
    # Welche Knoten haben dieselbe Tiefe wie KC1_Tiefe
    RP2<- ZHT2[which((ZHT2[,4]==KC1_Tiefe)),1]
    KC2<- Var_Rang(Tree=E2, Knoten=RP2, VIM=VIM); KC2[2]<- 0  # Rekombinationsknoten des 2. Elternteils

  # Suche Sohn- und Enkelknoten der Subtrees
    Links_2 <- ZHT2[which(ZHT2[,2]==0),]
    Rechts_2<- ZHT2[which(ZHT2[,2]==1),]
    i<- 1; j<-1
    while (j<=length(KC2)){
      if (KC2[j]!=-99){
          KC2[i+1]<- Links_2[which(Links_2[,1]==KC2[j]),3]
          KC2[i+2]<- Rechts_2[which(Rechts_2[,1]==KC2[j]),3]
          i       <- i+2
      }
      j<- j+1
    }

  # Alle zu loeschenden Vaterknoten ohne "-99" Eintraege
    KC2<- sort(KC2)
    while (KC2[1]<0) KC2<- KC2[-1]

  # Extrahieren der Subtrees und Loeschen der Subtrees aus den Eltern-ZHT:
    temp2a<- c(); temp2b<- c()
    for (i in 1:length(KC2)){
         temp2a<- c(temp2a, which(ZHT2[,1]==KC2[i]))
         temp2b<- c(temp2b, which(E2$Varis[,1]==KC2[i]))
    }

    ZHT2_kurz          <- ZHT2[-temp2a,]
    Varis2_kurz        <- matrix(E2$Varis[-temp2b,], ncol=2)
    CO2_kurz           <- matrix(E2$CO[-temp2b,], ncol=2)
    ZHT2_Subtree_sauber<- ZHT2_Subtree<- ZHT2[temp2a,]
    Varis2_Subtree     <- matrix(E2$Varis[temp2b,], ncol=2)
    CO2_Subtree        <- matrix(E2$CO[temp2b,], ncol=2)


  ##########################
  # KOMBINATION DER ELTERN #
  ##########################
  # Elternteil 1 + Subtree von Elternteil 2
    MAX1<- max(ZHT1_kurz[,1])  # Maximaler Vaterknoten in der verkuerzten ZHT1
    
    # Subtree2 benoetigt Eintraege mit anderen Zahlen als ZHT1_kurz
      temp99_2                       <- which(ZHT2_Subtree_sauber[,3]!=-99)
      ZHT2_Subtree_sauber[,1]        <- ZHT2_Subtree_sauber[,1]        -KC2[1]+1+MAX1
      ZHT2_Subtree_sauber[temp99_2,3]<- ZHT2_Subtree_sauber[temp99_2,3]-KC2[1]+1+MAX1
      Varis2_Subtree[,1]             <- Varis2_Subtree[,1]             -KC2[1]+1+MAX1
      CO2_Subtree[,1]                <- CO2_Subtree[,1]                -KC2[1]+1+MAX1

    # Schreibe neuen Subtree an Stelle des alten Subtrees
      ZHT1_kurz[which(ZHT1_kurz[,3]==KC1[1]),3]<- ZHT2_Subtree_sauber[1,1] 
      ZHT_child1                               <- rbind(ZHT1_kurz, ZHT2_Subtree_sauber)
      Varis_child1                             <- rbind(Varis1_kurz, Varis2_Subtree)
      CO_child1                                <- rbind(CO1_kurz, CO2_Subtree)
      
      Child1<- list(Zusammenhangstabelle=ZHT_child1[,1:3], 
                    Knoten=nrow(ZHT_child1)/2, Varis=Varis_child1, CO=CO_child1)

  # Elternteil 2 + Subtree von Elternteil 1
    MAX2<- max(ZHT2_kurz[,1])  # Maximaler Vaterknoten in der verkuerzten ZHT1
    
    # Subtree2 benoetigt Eintraege mit anderen Zahlen als ZHT2_kurz
      temp99_1                       <- which(ZHT1_Subtree_sauber[,3]!=-99)
      ZHT1_Subtree_sauber[,1]        <- ZHT1_Subtree_sauber[,1]        -KC1[1]+1+MAX2
      ZHT1_Subtree_sauber[temp99_1,3]<- ZHT1_Subtree_sauber[temp99_1,3]-KC1[1]+1+MAX2
      Varis1_Subtree[,1]             <- Varis1_Subtree[,1]             -KC1[1]+1+MAX2
      CO1_Subtree[,1]                <- CO1_Subtree[,1]                -KC1[1]+1+MAX2

    # Schreibe neuen Subtree an Stelle des alten Subtrees
      ZHT2_kurz[which(ZHT2_kurz[,3]==KC2[1]),3]<- ZHT1_Subtree_sauber[1,1] 
      ZHT_child2                               <- rbind(ZHT2_kurz, ZHT1_Subtree_sauber)
      Varis_child2                             <- rbind(Varis2_kurz, Varis1_Subtree)
      CO_child2                                <- rbind(CO2_kurz, CO1_Subtree)
      
      Child2<- list(Zusammenhangstabelle=ZHT_child2[,1:3], 
                    Knoten=nrow(ZHT_child2)/2, Varis=Varis_child2, CO=CO_child2)

  # Fitnessorientierte Hoist-Mutation, falls Kinder groesser als maximal erlaubt
    if (Child1$Knoten>Max_Knoten) Child1<- Delete_EL(Tree=Child1, Daten=Daten, N_Varis=N_Varis, uS=uS, oS=oS)
    if (Child1$Knoten>Max_Knoten){
        Child1<- Mutation_Hoist_Fitness(Tree=Child1, Datensatz=Daten, CV_Laeufe=CV_Laeufe)
        while (Child1$Knoten>Max_Knoten) Child1<- Delete_Branch_random(Tree=Child1)  
    }

    if (Child2$Knoten>Max_Knoten) Child2<- Delete_EL(Tree=Child2, Daten=Daten, N_Varis=N_Varis, uS=uS, oS=oS)
    if (Child2$Knoten>Max_Knoten){
        Child2<- Mutation_Hoist_Fitness(Tree=Child2, Datensatz=Daten, CV_Laeufe=CV_Laeufe)
        while (Child2$Knoten>Max_Knoten) Child2<- Delete_Branch_random(Tree=Child2)  
    }

  # Ausgabe:
    Ausgabe     <- list()
    Ausgabe[[1]]<- Child1
    Ausgabe[[2]]<- Child2
    Ausgabe[[3]]<- KC1[1]
    Ausgabe[[4]]<- KC2[1]
    return(Ausgabe)
}