# R/mogavs-internal.R In mogavs: Multiobjective Genetic Algorithm for Variable Selection in Regression

#### Defines functions .updatePopulationMembers.sortByComplexity.removeDuplicates.nonDomination.mutation.initializePop.evaluateOffspring.crossover

```.crossover <-
function(numberOfOffsprings, parent1, parent2, crossoverProbability=0.9){
if(missing(numberOfOffsprings) | numberOfOffsprings==0)
stop("Arg numberOfOffsprings is missing or zero")
if(missing(parent1))
stop("Arg parent1 is missing")
if(missing(parent2))
stop("Arg parent2 is missing")
#Note that lambda should preferably be even. If it isn't then the
#code produces an extra offspring but returns exactly lambda offsprings

numberOfCrossovers<-ceiling(numberOfOffsprings/2)
n<-ncol(parent1)

if(!exists("crossoverProbability")){
crossoverProbability<-1
}

#initialize offspring
offspring1<-matrix(0,numberOfCrossovers,n)
offspring2<-matrix(0,numberOfCrossovers,n)

for(i in 1:numberOfCrossovers){
a<-1+floor(runif(1)*nrow(parent1))
b<-1+floor(runif(1)*nrow(parent2))
crossoverSite<-floor(runif(1)*n)
if(crossoverSite !=0 && runif(1)<=crossoverProbability){
offspring1[i,]<-c(parent1[a,1:crossoverSite],parent2[b,(crossoverSite+1):n])
offspring2[i,]<-c(parent2[b,1:crossoverSite],parent1[a,(crossoverSite+1):n])
}
else{
offspring1[i,]<-parent1[a,]
offspring2[i,]<-parent2[b,]
}
}

offspring<-rbind(offspring1,offspring2)

#If lambda is odd then the last offspring is eliminated
offspring<-offspring[1:numberOfOffsprings,]
if(!is.matrix(offspring)){offspring<-matrix(offspring,1,length(offspring))}
return(offspring)
}
.evaluateOffspring <-
function(offspring,x,y){
if(missing(offspring))
stop("Arg offspring is missing")
if(missing(x))
stop("Arg x is missing")
if(missing(y))
stop("Arg y is missing")

MSEChildren<-matrix(0,1,nrow(offspring))
numOfVariablesChildren<-matrix(0,1,nrow(offspring))
for(i in 1:nrow(offspring)){
yy<-y
xx<-cbind(matrix(1,nrow(x),1), x[,which(offspring[i,]==1)])
beta_coeff_child<-qr.solve(xx,yy)

numOfVariablesChildren[i]=sum(offspring[i,])
MSEChildren[i]=sum((yy-xx%*%beta_coeff_child)^2)/length(yy)

}
output<-list(numOfVariablesChildren,MSEChildren)
return(output)
}
.initializePop <-
function(popSize, x, y){

if(missing(popSize))
stop("Arg popSize is missing")
if(missing(x))
stop("Arg x is missing")
if(missing(y))
stop("Arg y is missing")

sampleSize<-nrow(x)
#N is the number of independent variable
numOfVariables<-ncol(x)

obj1<-matrix(0,1,max(numOfVariables,popSize))
obj2<-matrix(0,1,max(numOfVariables,popSize))
popMembers<-matrix(0,max(numOfVariables,popSize),numOfVariables)

correlationCoefficient<-cor(y,x)
sortedCorr<-sort(abs(correlationCoefficient),decreasing=T,index.return=T)

for(i in 1:numOfVariables){
popMembers[i,sortedCorr\$ix[1:i]]=1
}

for(i in 1:numOfVariables){
yy<-y
xx<-cbind(matrix(1,nrow(x),1),x[,which(popMembers[i,]==1)])
beta_coeff<-qr.solve(xx,yy)

obj1[,i]=i
obj2[,i]=sum((yy-xx%*%beta_coeff)^2)/length(yy)
}

if(popSize<numOfVariables){
popMembers<-popMembers[1:popSize,]
obj1<-obj1[,1:popSize,drop=FALSE]
obj2<-obj2[,1:popSize,drop=FALSE]
}
if(popSize>numOfVariables){
popMembers[(numOfVariables+1):popSize,]<-popMembers[1:(popSize-numOfVariables),]
obj1[,(numOfVariables+1):popSize]<-obj1[1:(popSize-numOfVariables),drop=FALSE]
obj2[,(numOfVariables+1):popSize]<-obj2[1:(popSize-numOfVariables),drop=FALSE]
}
output<-list(popMembers,obj1,obj2)
return(output)
}
.mutation <-
function(offspring,mutationProbability=1/ncol(offspring)){
if(missing(offspring))
stop("Arg offspring is missing")

numOfOffspring<-nrow(offspring)
numOfVariables<-ncol(offspring)

if(!exists("mutationProbability")){
mutationProbability<-1/numOfOffspring
}

randomMatrix<-matrix(runif(numOfOffspring*numOfVariables),numOfOffspring,numOfVariables)
offspring[which(randomMatrix<=mutationProbability)]<-1-offspring[which(randomMatrix<=mutationProbability)]
return(offspring)
}
.nonDomination <-
function(obj1Members, obj2Members, members){
if(missing(obj1Members))
stop("Arg obj1Members is missing")
if(missing(obj2Members))
stop("Arg obj2Members is missing")
if(missing(members))
stop("Arg members is missing")
#allMembers contain [nonDominated;dominatedMembers]
#The entries with value 1 in the vector named dominatedBoolean will be the dominated solutions
#The entries with value 0 in the vector named dominatedBoolean will be the non-dominated solutions

noOfMembers<-nrow(members)
dominatedBoolean<-matrix(0,noOfMembers,1)

for(i in 1:noOfMembers){
if(dominatedBoolean[i]==0){
for(j in 1:noOfMembers){
if(dominatedBoolean[j]==0){
if((obj2Members[i]<=obj2Members[j]) && (obj1Members[i]<=obj1Members[j]) && ((obj2Members[i]<obj2Members[j]) || (obj1Members[i]<obj1Members[j]))){
dominatedBoolean[j]<-1
}
}
}
}
}

obj1AllMembers<-obj1Members
obj2AllMembers<-obj2Members

l<-which(dominatedBoolean==0)
nonDominatedMembers<-matrix(0,noOfMembers-sum(dominatedBoolean),ncol(members))
if(nrow(nonDominatedMembers)>0){
for(i in 1:nrow(nonDominatedMembers)){
nonDominatedMembers[i,]<-members[l[i],]
obj1AllMembers[i]<-obj1Members[l[i]]
obj2AllMembers[i]<-obj2Members[l[i]]
}
}

l<-which(dominatedBoolean==1)
dominatedMembers<-matrix(0,sum(dominatedBoolean),ncol(members))
if(nrow(dominatedMembers)>0){
for(i in 1:nrow(dominatedMembers)){
dominatedMembers[i,]<-members[l[i],]
obj1AllMembers[i+nrow(nonDominatedMembers)]<-obj1Members[l[i]]
obj2AllMembers[i+nrow(nonDominatedMembers)]<-obj2Members[l[i]]
}
}

if(nrow(dominatedMembers)>0 && nrow(nonDominatedMembers)>0){
allMembers<-rbind(nonDominatedMembers,dominatedMembers)
}
if(nrow(dominatedMembers)==0 && nrow(nonDominatedMembers)>0){
allMembers<-rbind(nonDominatedMembers)
}
if((nrow(dominatedMembers)>0) && (nrow(nonDominatedMembers)==0)){
allMembers<-rbind(dominatedMembers)
}
output<-list(nonDominatedMembers,dominatedMembers,allMembers,obj1AllMembers,obj2AllMembers)

return(output)
}
.Random.seed <-
c(403L, 65L, 24604460L, 2084420359L, -1079130330L, -500643904L,
1927520024L, 1838257364L, 1381563235L, -1907199619L, -1561983429L,
1290012267L, 1837777274L, -312183753L, -502523975L, -397865195L,
1163424760L, 831396104L, -807374424L, -822873510L, -1308131103L,
729751707L, -246010754L, 2077830194L, -917643598L, 1832113436L,
1705480766L, 174447329L, 629431613L, -891048624L, 1466640918L,
-862267919L, 1351270038L, -222710985L, 115866080L, -1664629345L,
781279902L, -1293560639L, -608745959L, 483497699L, 272240467L,
-918925548L, 1256733538L, 1024869540L, -70437177L, -1505351443L,
1464818361L, -254162078L, 741747227L, 2124712367L, 2030387942L,
250200898L, -1506870209L, 1719684348L, 102243001L, 1742091118L,
1327702021L, 223665680L, 696484620L, -1599185314L, 1577946923L,
641449352L, 1029624718L, -1819597843L, -48554678L, 1555442242L,
-2035622845L, 743429554L, -1439689126L, -802885495L, -301278868L,
863155810L, 1325591627L, 1307547872L, -1981860299L, -1734273103L,
-707387251L, 235531675L, 1106852279L, -876427865L, 2142640007L,
-1699256296L, -994165720L, 1419039395L, 1616988387L, 1023594598L,
78027264L, -785350884L, -403852674L, 109521421L, 571609447L,
1835802340L, 1345168490L, -1727041541L, 1010879367L, 1377951706L,
-2139764846L, 837127417L, 596679826L, -1244529048L, 1990692043L,
655578531L, 423283527L, -695138861L, 1210278074L, -1088180231L,
-303999327L, -1133000712L, 1298725637L, 1124134182L, -1477100475L,
-1903748500L, -1599420936L, 1275697478L, -169585136L, -2121231965L,
-1266516877L, 1395395497L, -418374911L, -226860782L, -1443017301L,
-287238066L, 1224447154L, -1280277112L, 1235422252L, 1491197837L,
940695467L, -908428482L, -1755446852L, -75901246L, -1433413895L,
859282077L, 689562985L, 1456391202L, -1877894207L, -1083364379L,
77502789L, 1422411690L, -516041510L, 1726543347L, -1911662005L,
906276497L, -348279107L, 405397583L, -243484800L, -835972280L,
-1454435058L, -1130501930L, 624352614L, 202296343L, -1751492068L,
486888617L, -267770779L, -1946088389L, 828822708L, 1112401913L,
-39448164L, -1698230122L, 1583912069L, -732817029L, 577126739L,
-24570346L, -1879563550L, 1432124821L, -1616310711L, -269305329L,
1799701242L, 972452489L, -369377431L, 404100753L, -472642086L,
1989562523L, -376995841L, 725164464L, 949063120L, 1415684982L,
-2053588553L, 479159122L, 1447778159L, -25006718L, -225092060L,
-1396480004L, -681609781L, 1618155714L, -1511125115L, -1227567721L,
-398215777L, -1366317527L, -1224204314L, -1611133431L, 1189082879L,
-1061215083L, 1969062795L, 851971870L, -733104818L, -66260306L,
1809437159L, 2112337509L, 1586578002L, -690114336L, 1464935413L,
-1432076882L, -1662499573L, 1671631544L, -1756928524L, -987122280L,
-729760146L, 1991314821L, 1771298362L, 915625350L, 159282789L,
645381417L, 886897601L, -491811409L, -815761085L, -778390874L,
87607196L, 2138851679L, -1286669344L, -1305408961L, 374790485L,
-660617077L, 217043303L, -603987591L, 813071237L, -1991523890L,
689465818L, -1372964163L, 1914284731L, 1325557217L, -926701711L,
2013235359L, 299296934L, -759287225L, -179683592L, 2001348415L,
474459361L, 2131603321L, -448812891L, 433397913L, -268121685L,
1302104834L, 1975768128L, 165946213L, 2091654048L, -741640403L,
257440665L, 1125482938L, -903074029L, -35821014L, -244822167L,
205059374L, -1645405242L, -1113667614L, 1115203678L, -2105465584L,
414295577L, 89320122L, 190417050L, -1830930201L, 1564388514L,
-443843836L, -775501629L, 263352294L, 401574020L, 1745180969L,
512931490L, -1367926893L, -215178240L, -2110708766L, 542460387L,
1082706531L, -1622329553L, 1848889841L, 1412047881L, 742515093L,
1667494708L, 933550953L, 339050729L, -1024727129L, -2043152185L,
2018119734L, -318507670L, -783605700L, -140563557L, 1296207167L,
-912462919L, 324150634L, 1802131135L, 900452975L, 1622355720L,
-1188834617L, -963506112L, -1321115730L, -1145762811L, -630492120L,
211629946L, 492342374L, -505015889L, 1016125006L, 1792825088L,
-1133835938L, -755604787L, -385366884L, 360652834L, 831356332L,
-1326694728L, 103536600L, 551734003L, -10643210L, 1936940589L,
141042452L, -879192685L, -1800652935L, -1048139939L, 1839921179L,
925420689L, 992352531L, 1808145204L, 652880444L, 150067042L,
-63092821L, 1289957814L, -447575865L, -2027928374L, 1980223655L,
254596599L, 1260946562L, -80342149L, -195193104L, -1144883839L,
-1038832274L, -1461490331L, 575807779L, -1075842769L, -1040705619L,
658658078L, -1634921424L, 1695011313L, -1867114304L, -1656100836L,
-955503903L, 1113641304L, 161375544L, -1569488934L, -1700391122L,
1675096836L, -1514129750L, -1939558356L, 1832101256L, -1566639570L,
828877549L, 905031177L, 2038694527L, 971017589L, 1993679749L,
525235195L, 1591242911L, -742139813L, 1667242462L, -2129205253L,
1479777227L, -1062101093L, 579517076L, -1497804529L, 513914306L,
589559182L, 1796404184L, 2116534157L, 999146709L, -1585510506L,
-1746242590L, -1053058746L, -1478403834L, -1046160032L, 539604899L,
-1527413063L, 1234123974L, -1200864535L, 1237898679L, 1093133999L,
-405348144L, 1418868774L, -1542724041L, 54601556L, 267022501L,
121103006L, 1900771337L, 159706882L, 1040770478L, 1399219263L,
-1687580760L, 1599145416L, -55193567L, 2147371120L, 141405645L,
-73980696L, -195091869L, -655835729L, -368193542L, -771638442L,
-775536523L, -815785368L, 1731925503L, 1227350975L, 404809359L,
-1536939461L, -1363557275L, -274938436L, -35241078L, 647859754L,
-1661027045L, 1397028213L, -848288656L, 1832876140L, -1364017109L,
1239475993L, -275712276L, -1523125334L, -1775666133L, -1814976192L,
-674102332L, -406167400L, 950076535L, -913812808L, -407993545L,
-388493354L, -1299040043L, -1383651102L, -1707389744L, 1085820263L,
-458848596L, -1919521485L, 37692906L, 352614152L, 2039419599L,
1163660302L, 570773932L, 1030181299L, 183949657L, 134880233L,
-719686448L, 238845211L, 929691727L, 1378802825L, -1054113412L,
2106745686L, 1381208050L, 2059605483L, 280130588L, -935256704L,
-2045696174L, 638944030L, -135184809L, -718499052L, -687869258L,
645292772L, 954428755L, -409608971L, -385835412L, 337115797L,
-1730079278L, -572575893L, 372196487L, 1041690277L, -646373625L,
-235247560L, -807089237L, 2122721678L, 119457174L, 52057432L,
12883294L, -298850192L, 390459534L, -1459918488L, 757813118L,
-722768264L, 1594335334L, -250377693L, -1193937759L, -1407760241L,
1532621024L, -1498853826L, 771955793L, -1249935398L, -913438615L,
1095700134L, 1377467394L, -860806838L, 1046068215L, 25253168L,
1996391234L, -191094365L, -553085047L, 2076157561L, 2015267872L,
150485115L, 2074779540L, 213360481L, -681980327L, 1287851158L,
1108273184L, 979720574L, -28142959L, 2046179248L, -1367208412L,
657643331L, 1833678275L, 360418113L, 12268263L, -1655909631L,
559033692L, 93004187L, 1152366901L, 1847868281L, 1894464301L,
-471830219L, -1812383453L, 1957783380L, 1058082028L, 342410051L,
-1851098201L, -1396561790L, -1097054144L, -1681451518L, -28448473L,
1565187565L, 1925067454L, -1359205319L, 1661020484L, 853222308L,
-1874475159L, -2094363134L, -1187679972L, 273498564L, 513996393L,
-1201204110L, 1088442906L, 1255378381L, -938382330L, -1859547650L,
1392380802L, 1453502868L, -361347465L, 625485664L, -1336038448L,
-320359036L, 2062479173L, 499985580L, -834645143L, 1628815895L,
1222133530L, 378722653L, -59150227L, -570894111L, 2104625682L,
683610662L, -1010670273L, -394068767L, 711719280L, -1927302404L,
1104930333L, 1595679464L, 1327587183L, -401146485L, -1444330265L,
1169718869L, -1435735817L, -1522047040L, 1372954985L, 1589257835L,
-642846342L, 88310125L, 1852321190L, 292880901L, 263402855L,
1761111080L, 658270484L, 1225301316L, -1993602560L, -939960588L,
-1622747735L, 1474294783L, -932057258L, 1250870764L, 486358072L,
1283727760L, 805322789L, -1112365054L, -1548975092L, 1798699182L,
686444897L, 415465575L, 1465876344L, -938828663L, 9418064L, 244046574L,
-676713965L, 1672788432L, 1863299107L, -1424375532L, 16095288L,
-1493206408L, -674571790L, 1786052064L, 1823599036L, -1855083395L,
-321459838L, 1409039813L, 2004852403L, 96684943L, -791876812L,
-404818183L, 170571065L, 211102239L, -1934339211L, -1035996233L,
-414580228L, -2144541755L, 663579081L, 696316637L, 896374719L,
-764888473L, -1654726514L, -91454727L, -1739388359L)
.removeDuplicates <-
function(vector,obj1Vector,obj2Vector){
if(missing(vector))
stop("Arg vector is missing")
if(missing(obj1Vector))
stop("Arg obj1Vector is missing")
if(missing(obj2Vector))
stop("Arg obj2Vector is missing")

I<-!duplicated(vector,MARGIN=1)
newVector<-vector[I,]
newObj1Vector<-obj1Vector[I]
newObj2Vector<-obj2Vector[I]

output<-list(newVector,newObj1Vector,newObj2Vector)
return(output)
}
.sortByComplexity <-
function(members,obj1,obj2){
if(missing(members))
stop("Arg members is missing")
if(missing(obj1))
stop("Arg obj1 is missing")
if(missing(obj2))
stop("Arg obj2 is missing")

complexity<-apply(members,1,sum)

sortedComplexity<-sort.int(complexity, index.return=T)
orderedMembers<-members[sortedComplexity\$ix,]
if(!is.matrix(orderedMembers)){orderedMembers<-matrix(orderedMembers,1,length(orderedMembers))}
newObj1<-obj1[sortedComplexity\$ix]
newObj2<-obj2[sortedComplexity\$ix]
output<-list(orderedMembers,newObj1,newObj2)
return(output)
}
.updatePopulationMembers <-
function(nonDominatedSet, dominatedSet, popMembersAugmented, obj1Augmented, obj2Augmented, popSize){
if(missing(nonDominatedSet))
stop("Arg nonDominatedSet is missing")
if(missing(dominatedSet))
stop("Arg dominatedSet is missing")
if(missing(popMembersAugmented))
stop("Arg popMembersAugmented is missing")
if(missing(obj1Augmented))
stop("Arg obj1Augmented is missing")
if(missing(obj2Augmented))
stop("Arg obj1Augmented is missing")
if(missing(popSize))
stop("Arg popSize is missing")

#trueNonDominatedSet variable actually stores the (elite) non dominated members. The variable
#NonDominatedSet later on takes some dominated members as well to form the next population members.

trueNonDominatedSet<-nonDominatedSet

while(nrow(nonDominatedSet)<popSize){
temp<-.nonDomination(obj1Augmented[(nrow(nonDominatedSet)+1):length(obj1Augmented)],obj2Augmented[(nrow(nonDominatedSet)+1):length(obj2Augmented)],dominatedSet)
nonDomTemp<-temp[[1]]
domTemp<-temp[[2]]

popMembersAugmented[(nrow(nonDominatedSet)+1):nrow(popMembersAugmented),]<-temp[[3]]
obj1Augmented[(nrow(nonDominatedSet)+1):length(obj1Augmented)]<-temp[[4]]
obj2Augmented[(nrow(nonDominatedSet)+1):length(obj2Augmented)]<-temp[[5]]
rm(temp)

if(!is.matrix(nonDomTemp)){
print("nonDomTemp was not a matrix")
print(nonDomTemp)
}
temp<-.sortByComplexity(nonDomTemp,obj1Augmented[(nrow(nonDominatedSet)+1):(nrow(nonDominatedSet)+nrow(nonDomTemp))],obj2Augmented[(nrow(nonDominatedSet)+1):(nrow(nonDominatedSet)+nrow(nonDomTemp))])
if(!is.matrix(temp[[1]])){
print("temp[[1]] was not a matrix")
print(temp[[1]])
}
nonDomTemp<-temp[[1]]
obj1Augmented[(nrow(nonDominatedSet)+1):(nrow(nonDominatedSet)+nrow(nonDomTemp))]<-temp[[2]]
obj2Augmented[(nrow(nonDominatedSet)+1):(nrow(nonDominatedSet)+nrow(nonDomTemp))]<-temp[[3]]
rm(temp)

popMembersAugmented[(nrow(nonDominatedSet)+1):(nrow(nonDominatedSet)+nrow(nonDomTemp)),]<-nonDomTemp
nonDominatedSet<-rbind(nonDominatedSet,nonDomTemp)
dominatedSet<-domTemp
}

if(nrow(nonDominatedSet)<popSize){ #this will never happen if initial pop doesn't contain duplicates
randomVector<-ceiling(nrow(nonDominatedSet)*runif(popSize))
popMembers<-nonDominatedSet[randomVector,]

} else{
popMembers<-nonDominatedSet[1:popSize,]
}

if(popSize<=nrow(trueNonDominatedSet)){
eliteMembers<-popMembers
} else{
eliteMembers<-trueNonDominatedSet
}

numOfVariables<-t(obj1Augmented[1:popSize])
MSE<-t(obj2Augmented[1:popSize])

output<-list(popMembers, numOfVariables, MSE, eliteMembers)
return(output)
}
```

## Try the mogavs package in your browser

Any scripts or data that you put into this service are public.

mogavs documentation built on May 2, 2019, 1 a.m.