R/rule_family_library.R In crso: Cancer Rule Set Optimization ('crso')

```### This file contains functions for making family matrix (fm) associated with rm.

### None of the functions are exported
### 1. getFamMat(rm)
### 2. isRSvalid(rm,rs,fam.mat)
### 3. getDaughtersOfRule(rule,rm)
### 4. getParentsOfRule(rule,rm)

# 1) This function takes in rule space and makes matrix of family members.
# Rules are considered to be family members with themselves.
getFamMat <- function(rm){
fam.mat <- matrix(0,nrow=nrow(rm),ncol=nrow(rm))
rownames(fam.mat) <- rownames(rm)
colnames(fam.mat) <- rownames(rm)

for(j in 1:nrow(fam.mat)){
daughters <- getDaughtersOfRule(rm[j,],rm)
parents <- getParentsOfRule(rm[j,],rm)
fams <- setdiff(union(daughters,parents),NA)
fams <- c(j,fams)
fam.mat[j,fams] <- 1
#if(j%%50==0)print(j)
}
return(fam.mat)
}

# 2) Check if rule set is valid, i.e., there are no two family members in the rule set
# rs is represented as a vector of indices of rm
isRSvalid <- function(rm,rs,fm){
### Assume rs in indices of rules in rm
if(length(rs)==1) return(TRUE)
for(j in 1:length(rs)){
cur.rule <- rs[j]
fams <- setdiff(which(fm[cur.rule,]==1),cur.rule)
if(length(intersect(fams,rs))>0) return(FALSE)
}
return(TRUE)
}

# 3)
getDaughtersOfRule <- function(rule,rm){
off.idc <- sort(which(rule==0))
if(length(off.idc)==0) return(c(1:(nrow(rm)-1))) ### If all are on then everything is daughter
daughter.idc <- c()

for(j in 1:nrow(rm)){
temp <- intersect(which(rm[j,]==0),off.idc)
if(length(temp)==length(off.idc))   {
if(!identical(rm[j,],rule)) daughter.idc <- c(daughter.idc,j)
}
}
if(length(daughter.idc)==0)return(NA)
return(daughter.idc)
}

# 4)
getParentsOfRule <- function(rule,rm){
on.idc <- sort(which(rule==1))
if(length(on.idc)==length(rule)) return(NA) ### If all are on then everything is daughter
parent.idc <- c()
for(j in 1:nrow(rm)){
temp <- intersect(which(rm[j,]==1),on.idc)
if(length(temp)==length(on.idc))   {
if(!identical(rm[j,],rule)) parent.idc <- c(parent.idc,j)
}
}
if(length(parent.idc)==0) return(NA)
return(parent.idc)
}
```

Try the crso package in your browser

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

crso documentation built on July 7, 2019, 5:02 p.m.