.csPrediction <- function(W,Y0,method){
###This function implements the label propagation to predict the label(subtype) for new patients.
### note method is an indicator of which semi-supervised method to use
# method == 0 indicates to use the local and global consistency method
# method >0 indicates to use label propagation method.
alpha=0.9;
P= W/rowSums(W)
if(method==0){
Y= (1-alpha)* solve( diag(dim(P)[1])- alpha*P)%*%Y0;
} else {
NLabel=which(rowSums(Y0)==0)[1]-1;
Y=Y0;
for (i in 1:1000){
Y=P%*%Y;
Y[1:NLabel,]=Y0[1:NLabel,];
}
}
return(Y);
}
.discretisation <- function(eigenVectors) {
normalize <- function(x) x / sqrt(sum(x^2))
eigenVectors = t(apply(eigenVectors,1,normalize))
n = nrow(eigenVectors)
k = ncol(eigenVectors)
R = matrix(0,k,k)
R[,1] = t(eigenVectors[round(n/2),])
mini <- function(x) {
i = which(x == min(x))
return(i[1])
}
c = matrix(0,n,1)
for (j in 2:k) {
c = c + abs(eigenVectors %*% matrix(R[,j-1],k,1))
i = mini(c)
R[,j] = t(eigenVectors[i,])
}
lastObjectiveValue = 0
for (i in 1:20) {
eigenDiscrete = .discretisationEigenVectorData(eigenVectors %*% R)
svde = svd(t(eigenDiscrete) %*% eigenVectors)
U = svde[['u']]
V = svde[['v']]
S = svde[['d']]
NcutValue = 2 * (n-sum(S))
if(abs(NcutValue - lastObjectiveValue) < .Machine$double.eps)
break
lastObjectiveValue = NcutValue
R = V %*% t(U)
}
return(list(discrete=eigenDiscrete,continuous =eigenVectors))
}
.discretisationEigenVectorData <- function(eigenVector) {
Y = matrix(0,nrow(eigenVector),ncol(eigenVector))
maxi <- function(x) {
i = which(x == max(x))
return(i[1])
}
j = apply(eigenVector,1,maxi)
Y[cbind(1:nrow(eigenVector),j)] = 1
return(Y)
}
.dominateset <- function(xx,KK=20) {
###This function outputs the top KK neighbors.
zero <- function(x) {
s = sort(x, index.return=TRUE)
x[s$ix[1:(length(x)-KK)]] = 0
return(x)
}
normalize <- function(X) X / rowSums(X)
A = matrix(0,nrow(xx),ncol(xx));
for(i in 1:nrow(xx)){
A[i,] = zero(xx[i,]);
}
return(normalize(A))
}
# Calculate the mutual information between vectors x and y.
.mutualInformation <- function(x, y) {
classx <- unique(x)
classy <- unique(y)
nx <- length(x)
ncx <- length(classx)
ncy <- length(classy)
probxy <- matrix(NA, ncx, ncy)
for (i in 1:ncx) {
for (j in 1:ncy) {
probxy[i, j] <- sum((x == classx[i]) & (y == classy[j])) / nx
}
}
probx <- matrix(rowSums(probxy), ncx, ncy)
proby <- matrix(colSums(probxy), ncx, ncy, byrow=TRUE)
result <- sum(probxy * log(probxy / (probx * proby), 2), na.rm=TRUE)
return(result)
}
# Calculate the entropy of vector x.
.entropy <- function(x) {
class <- unique(x)
nx <- length(x)
nc <- length(class)
prob <- rep.int(NA, nc)
for (i in 1:nc) {
prob[i] <- sum(x == class[i])/nx
}
result <- -sum(prob * log(prob, 2))
return(result)
}
.repmat = function(X,m,n){
##R equivalent of repmat (matlab)
if (is.null(dim(X))) {
mx = length(X)
nx = 1
} else {
mx = dim(X)[1]
nx = dim(X)[2]
}
matrix(t(matrix(X,mx,nx*n)),mx*m,nx*n,byrow=T)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.