R/getBinary.R

#' Binary set for multiclass data
#' 
#' A function to get the supersets and subsets for multiclass data
#' 
#' @param input a vector of multiclass data
#' @param data a matrix of multiclass data as training data
#' @return a list of the following components:
#' \item{superset}{the supersets of the input data from the training data}
#' \item{subset}{the subsets of the input data from the training data}
#' 
#' @author Liye He \email{liye.he@@helsinki.fi} 
#' @examples 
#' data(tyner_interaction_multiclass)
#' sets<-getBinary(tyner_interaction_multiclass[1,], tyner_interaction_multiclass)
getBinary<-function(input, data){
  #example:
  #input<-c(0,1,2,3)
  #data<-sample(0:5,40, T)
  #data<-array(data,dim=c(10,4))
  input1<-matrix(rep(input, nrow(data)), ncol=ncol(data), byrow=TRUE)
  res<-input1-data
  drugs<-c(1:nrow(data))
  neg_val<-which(res<0, arr.ind=TRUE)
  neg_row<-unique(neg_val[,1])
  #zeros<-apply(res,1, function(x) if(all(x==0)) return(1) else return(0))
  #identical<-which(zeros==1)
  zeros<-rowSums(abs(res))
  identical<-which(zeros==0)
  # subset no negative values
  sub<-setdiff(drugs, neg_row)
  sub<-setdiff(sub, intersect(sub, identical))
  
  
  pos_val<-which(res>0, arr.ind=TRUE)
  pos_row<-unique(pos_val[,1])
  # superset no positive values
  sup<-setdiff(drugs, pos_row)
  # weight for every superset to the input data
  
  #res1<-data-input1
  #minones<-apply(res,1, function(x) if(length(which(x<0))==0) return(1) else return(0))
  # get the index in the data for subset
  #sub<-which(minones==1)
  #sub<-data[which(minones==1),]    
  #positiveval<-apply(res,1, function(x) if(length(which(x>0))==0) return(1) else return(0))
  # get the index in the data for subset
  #sup<-which(positiveval==1)
  #sup<-data[which(positiveval==1),]
  return(list(subset=sub, superset=sup))
}

Try the timma package in your browser

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

timma documentation built on May 2, 2019, 1:10 p.m.