|
a |
|
b/Classify.R |
|
|
1 |
Classify <- |
|
|
2 |
function(x,y,xte=NULL,rho=0,beta=1,rhos=NULL,type=c("mle","deseq","quantile"), prior=NULL, transform=TRUE, alpha=NULL){ |
|
|
3 |
if(is.null(xte)){ |
|
|
4 |
xte <- x |
|
|
5 |
warning("Since no xte was provided, testing was performed on training data set.") |
|
|
6 |
} |
|
|
7 |
if(!is.null(rho) && length(rho)>1) stop("Can only enter 1 value of rho. If you would like to enter multiple values, use rhos argument.") |
|
|
8 |
type <- match.arg(type) |
|
|
9 |
if(!transform && !is.null(alpha)) stop("You have asked for NO transformation but have entered alpha.") |
|
|
10 |
if(transform && is.null(alpha)) alpha <- FindBestTransform(x) |
|
|
11 |
if(transform){ |
|
|
12 |
if(alpha<=0 || alpha>1) stop("alpha must be between 0 and 1") |
|
|
13 |
x <- x^alpha |
|
|
14 |
xte <- xte^alpha |
|
|
15 |
} |
|
|
16 |
if(is.null(prior)) prior <- rep(1/length(unique(y)), length(unique(y))) |
|
|
17 |
if(is.null(rho)&&is.null(rhos)) stop("Must enter rho or rhos.") |
|
|
18 |
null.out <- NullModel(x, type=type) |
|
|
19 |
ns <- null.out$n |
|
|
20 |
nste <- NullModelTest(null.out,x,xte,type=type)$nste |
|
|
21 |
uniq <- sort(unique(y)) |
|
|
22 |
if(is.null(rhos)){ |
|
|
23 |
ds <- GetD(ns,x,y,rho,beta) |
|
|
24 |
discriminant <- matrix(NA, nrow=nrow(xte), ncol=length(uniq)) |
|
|
25 |
for(k in 1:length(uniq)){ |
|
|
26 |
discriminant[,k] <- rowSums(scale(xte,center=FALSE,scale=(1/log(ds[k,])))) - rowSums(scale(nste,center=FALSE,scale=(1/ds[k,]))) + log(prior[k]) |
|
|
27 |
} |
|
|
28 |
save <- list(ns=ns,nste=nste,ds=ds,discriminant=discriminant,ytehat=uniq[apply(discriminant,1,which.max)], alpha=alpha, rho=rho,x=x,y=y,xte=xte,alpha=alpha,type=type) |
|
|
29 |
class(save) <- "poicla" |
|
|
30 |
return(save) |
|
|
31 |
} else { |
|
|
32 |
save <- list() |
|
|
33 |
ds.list <- GetD(ns,x,y,rho=NULL, rhos=rhos,beta) |
|
|
34 |
for(rho in rhos){ |
|
|
35 |
ds <- ds.list[[which(rhos==rho)]] |
|
|
36 |
discriminant <- matrix(NA, nrow=nrow(xte), ncol=length(uniq)) |
|
|
37 |
for(k in 1:length(uniq)){ |
|
|
38 |
discriminant[,k] <- rowSums(scale(xte,center=FALSE,scale=(1/log(ds[k,])))) - rowSums(scale(nste,center=FALSE,scale=(1/ds[k,]))) + log(prior[k]) |
|
|
39 |
} |
|
|
40 |
save[[which(rhos==rho)]] <- (list(ns=ns,nste=nste,ds=ds,discriminant=discriminant,ytehat=uniq[apply(discriminant,1,which.max)], alpha=alpha, rho=rho,x=x,y=y,xte=xte,alpha=alpha,type=type)) |
|
|
41 |
} |
|
|
42 |
class(save) <- "poicla" |
|
|
43 |
return(save) |
|
|
44 |
} |
|
|
45 |
} |
|
|
46 |
|