stiffnesses = 4 * (P[[i]] - Q) * num
if (i==1){
for (j in 1:n) {
if (!any(is.na(X[[i]][j,]))){
grads[j, ] = w[i]*apply(sweep(-ydata, 2, -ydata[j, ]) *
stiffnesses[, j], 2, sum)
}
}
} else {
for (j in 1:n) {
if (!any(is.na(X[[i]][j,]))){
grads[j, ] = grads[j,] + w[i]*apply(sweep(-ydata, 2, -ydata[j, ]) *
stiffnesses[, j], 2, sum)
}
}
}
grads
stiffness
stiffnesses
all(is.na(stiffnesses))
which(is.na(stiffnesses))
which(!is.na(stiffnesses))
length(stiffnesses))
length(stiffnesses
)
n
Q
P[[i]]
dim(Q)
num
dim(num)
dim(stiffnesses)
which(is.na(rowSums(stiffnesses)))
i
if (i==1){
for (j in 1:n) {
if (!any(is.na(X[[i]][j,]))){
grads[j, ] = w[i]*apply(sweep(-ydata, 2, -ydata[j, ]) *
stiffnesses[, j], 2, sum)
}
}
} else {
for (j in 1:n) {
if (!any(is.na(X[[i]][j,]))){
grads[j, ] = grads[j,] + w[i]*apply(sweep(-ydata, 2, -ydata[j, ]) *
stiffnesses[, j], 2, sum)
}
}
}
grads
#P = lapply(X, function(x) x2p(x,perplexity,1e-05)$P)
grads = matrix(0, nrow(ydata), ncol(ydata))
incs = matrix(0, nrow(ydata), ncol(ydata))
gains = matrix(1, nrow(ydata), ncol(ydata))
if (iter%%epoch == 0) {
total_cost = 0
for (i in 1:M){
temp_cost = 0
temp_cost = sum(apply(P[[i]] * log((P[[i]] + eps)/(Q + eps)), 1,
sum), na.rm=T)
message("Epoch: Iteration #", iter, ", data-view #",i, ", error is: ",
temp_cost)
total_cost = total_cost + temp_cost
}
message("Epoch: Iteration #", iter,  ", total error is: ",
total_cost)
if (total_cost < min_cost)
break
if (!is.null(epoch_callback))
epoch_callback(ydata)
}
sum_ydata = apply(ydata^2, 1, sum)
num = 1/(1 + sum_ydata + sweep(-2 * ydata %*% t(ydata),
2, -t(sum_ydata)))
diag(num) = 0
Q = num/sum(num, na.rm=T)
if (any(is.nan(num))){
message("NaN in grad. descent")
}
Q[Q < eps] = eps
grads
i=1
stiffnesses = 4 * (P[[i]] - Q) * num
if (i==1){
for (j in 1:n) {
if (!any(is.na(X[[i]][j,]))){
grads[j, ] = w[i]*apply(sweep(-ydata, 2, -ydata[j, ]) *
stiffnesses[, j], 2, sum)
}
}
} else {
for (j in 1:n) {
if (!any(is.na(X[[i]][j,]))){
grads[j, ] = grads[j,] + w[i]*apply(sweep(-ydata, 2, -ydata[j, ]) *
stiffnesses[, j], 2, sum)
}
}
}
grads
i=2
stiffnesses = 4 * (P[[i]] - Q) * num
if (i==1){
for (j in 1:n) {
if (!any(is.na(X[[i]][j,]))){
grads[j, ] = w[i]*apply(sweep(-ydata, 2, -ydata[j, ]) *
stiffnesses[, j], 2, sum)
}
}
} else {
for (j in 1:n) {
if (!any(is.na(X[[i]][j,]))){
grads[j, ] = grads[j,] + w[i]*apply(sweep(-ydata, 2, -ydata[j, ]) *
stiffnesses[, j], 2, sum)
}
}
}
grads
stiffnesses = 4 * (P[[i]] - Q) * num
i
i=
3
stiffnesses = 4 * (P[[i]] - Q) * num
for (j in 1:n) {
if (!any(is.na(X[[i]][j,]))){
grads[j, ] = w[i]*apply(sweep(-ydata, 2, -ydata[j, ]) *
stiffnesses[, j], 2, function(x)sum(x, na.rm = T))
}
}
grads
## Semi-supervised ##
# S-multi-SNE #
SmultiSNE <- function (X, initial_config = NULL, k = 2, initial_dims = 30,
perplexity = 30, max_iter = 1000, min_cost = 0, epoch_callback = NULL,
whitening = TRUE, epoch = 100, weights=NULL, weightUpdating=TRUE, lambdaParameter=1){
M <- length(X)
for (i in 1:M){
if ("dist" %in% class(X[[i]])) {
n = attr(X[[i]], "Size")
}
else {
if (any(is.na(X[[i]]))){
r <- apply(X[[i]], 1, function(x) any(is.na(x)))
Xnan <- X[[i]][r,]
Xclean <- X[[i]][!r,]
Xclean = as.matrix(Xclean)
Xclean = Xclean - min(Xclean)
Xclean = Xclean/max(Xclean)
initial_dims = min(initial_dims, ncol(Xclean))
if (whitening){
Xclean <- whiten(as.matrix(Xclean), n.comp = initial_dims)
}
X[[i]][r,]  <- Xnan
X[[i]][!r,] <- Xclean
} else {
X[[i]] = as.matrix(X[[i]])
X[[i]] = X[[i]] - min(X[[i]])
X[[i]] = X[[i]]/max(X[[i]])
initial_dims = min(initial_dims, ncol(X[[i]]))
if (whitening){
X[[i]] <- whiten(as.matrix(X[[i]]), n.comp = initial_dims)
}
}
}
}
# Prepare weights
if (is.null(weights)){
w <- rep(1,M)
} else {
w <- weights
}
w <- w/sum(w, na.rm=T)
Ctemp = rep(0,M)
z = rep(0,M) #  Used in the automatic update of weights
Weights = matrix(0, nrow = max_iter, ncol = M)
Errors = matrix(0, nrow = max_iter, ncol = M)
# Initialisation
n = nrow(X[[1]])
momentum = 0.5
final_momentum = 0.8
mom_switch_iter = 250
epsilon = 500
min_gain = 0.01
initial_P_gain = 4
eps = 2^(-52)
if (!is.null(initial_config) && is.matrix(initial_config)) {
if (nrow(initial_config) != n | ncol(initial_config) !=
k) {
stop("initial_config argument does not match necessary configuration for X")
}
ydata = initial_config
initial_P_gain = 1
} else {
ydata = matrix(rnorm(k * n), n)
}
P <- vector("list")
for (i in 1:M){
if (any(is.na(X[[i]]))){
r <- apply(X[[i]], 1, function(x) any(is.na(x)))
Xnan <- X[[i]][r,]
Xclean <- X[[i]][!r,]
Xclean = as.matrix(Xclean)
Pclean = x2p(Xclean, perplexity, 1e-05)$P
P[[i]] <- matrix(NA, nrow = nrow(X[[i]]), ncol = nrow(X[[i]]))
#P[[i]][r,] <- Xnan
P[[i]][!r,!r] <- Pclean
}else{
P[[i]] = x2p(X[[i]], perplexity, 1e-05)$P
}
P[[i]] = 0.5 * (P[[i]] + t(P[[i]]))
P[[i]][P[[i]] < eps] <- eps
P[[i]] = P[[i]]/sum(P[[i]], na.rm=T)
P[[i]] = P[[i]] * initial_P_gain
}
#P = lapply(X, function(x) x2p(x,perplexity,1e-05)$P)
grads = matrix(0, nrow(ydata), ncol(ydata))
incs = matrix(0, nrow(ydata), ncol(ydata))
gains = matrix(1, nrow(ydata), ncol(ydata))
for (iter in 1:max_iter) {
if (iter%%epoch == 0) {
total_cost = 0
for (i in 1:M){
temp_cost = 0
temp_cost = sum(apply(P[[i]] * log((P[[i]] + eps)/(Q + eps)), 1,
sum), na.rm=T)
message("Epoch: Iteration #", iter, ", data-view #",i, ", error is: ",
temp_cost)
total_cost = total_cost + temp_cost
}
message("Epoch: Iteration #", iter,  ", total error is: ",
total_cost)
if (total_cost < min_cost)
break
if (!is.null(epoch_callback))
epoch_callback(ydata)
}
sum_ydata = apply(ydata^2, 1, sum)
num = 1/(1 + sum_ydata + sweep(-2 * ydata %*% t(ydata),
2, -t(sum_ydata)))
diag(num) = 0
Q = num/sum(num, na.rm=T)
if (any(is.nan(num))){
message("NaN in grad. descent")
}
Q[Q < eps] = eps
for (i in 1:M){
stiffnesses = 4 * (P[[i]] - Q) * num
if (i==1){
for (j in 1:n) {
if (!any(is.na(X[[i]][j,]))){
grads[j, ] = w[i]*apply(sweep(-ydata, 2, -ydata[j, ]) *
stiffnesses[, j], 2, function(x)sum(x, na.rm = T))
}
}
} else {
for (j in 1:n) {
if (!any(is.na(X[[i]][j,]))){
grads[j, ] = grads[j,] + w[i]*apply(sweep(-ydata, 2, -ydata[j, ]) *
stiffnesses[, j], 2, function(x)sum(x, na.rm = T))
}
}
}
}
gains = ((gains + 0.2) * abs(sign(grads) != sign(incs)) +
gains * 0.8 * abs(sign(grads) == sign(incs)))
gains[gains < min_gain] = min_gain
incs = momentum * incs - epsilon * (gains * grads)
ydata = ydata + incs
ydata = sweep(ydata, 2, apply(ydata, 2, mean))
if (iter == mom_switch_iter)
momentum = final_momentum
for (i in 1:M){
C = sum(P[[i]]*log(P[[i]]/Q), na.rm=T)
if (is.na(C)){
Ctemp[i] <- 0
} else {
Ctemp[i] <- C
}
if (iter == 100 && is.null(initial_config)){
P[[i]] = P[[i]]/4
}
}
if (weightUpdating == TRUE){
wc = Ctemp
if (sum(wc, na.rm=T)==0){
wc <- rep(1,M)
}
wc <- wc/sum(wc, na.rm=T)
w <- 1-wc
w <- w/sum(w, na.rm=T)
} else{
w <- rep(1,M)
w <- w/sum(, na.rm=T)
}
Weights[iter,] <- w
Errors[iter,] <- Ctemp
}
return(list("Y" = ydata, "Weights" = Weights, "Errors" = Errors))
}
# Run S-multi-SNE
Y <- SmultiSNE(X, max_iter = 100, epoch=10)
plot(Y$Y, col = true_labels, pch=19)
plot(Y$Y, col = missing_labels, pch=19)
## Semi-supervised ##
# S-multi-SNE #
SmultiSNE <- function (X, initial_config = NULL, k = 2, initial_dims = 30,
perplexity = 30, max_iter = 1000, min_cost = 0, epoch_callback = NULL,
whitening = FALSE, epoch = 100, weights=NULL, weightUpdating=TRUE, lambdaParameter=1){
M <- length(X)
for (i in 1:M){
if ("dist" %in% class(X[[i]])) {
n = attr(X[[i]], "Size")
}
else {
if (any(is.na(X[[i]]))){
r <- apply(X[[i]], 1, function(x) any(is.na(x)))
Xnan <- X[[i]][r,]
Xclean <- X[[i]][!r,]
Xclean = as.matrix(Xclean)
Xclean = Xclean - min(Xclean)
Xclean = Xclean/max(Xclean)
initial_dims = min(initial_dims, ncol(Xclean))
if (whitening){
Xclean <- whiten(as.matrix(Xclean), n.comp = initial_dims)
}
X[[i]][r,]  <- Xnan
X[[i]][!r,] <- Xclean
} else {
X[[i]] = as.matrix(X[[i]])
X[[i]] = X[[i]] - min(X[[i]])
X[[i]] = X[[i]]/max(X[[i]])
initial_dims = min(initial_dims, ncol(X[[i]]))
if (whitening){
X[[i]] <- whiten(as.matrix(X[[i]]), n.comp = initial_dims)
}
}
}
}
# Prepare weights
if (is.null(weights)){
w <- rep(1,M)
} else {
w <- weights
}
w <- w/sum(w, na.rm=T)
Ctemp = rep(0,M)
z = rep(0,M) #  Used in the automatic update of weights
Weights = matrix(0, nrow = max_iter, ncol = M)
Errors = matrix(0, nrow = max_iter, ncol = M)
# Initialisation
n = nrow(X[[1]])
momentum = 0.5
final_momentum = 0.8
mom_switch_iter = 250
epsilon = 500
min_gain = 0.01
initial_P_gain = 4
eps = 2^(-52)
if (!is.null(initial_config) && is.matrix(initial_config)) {
if (nrow(initial_config) != n | ncol(initial_config) !=
k) {
stop("initial_config argument does not match necessary configuration for X")
}
ydata = initial_config
initial_P_gain = 1
} else {
ydata = matrix(rnorm(k * n), n)
}
P <- vector("list")
for (i in 1:M){
if (any(is.na(X[[i]]))){
r <- apply(X[[i]], 1, function(x) any(is.na(x)))
Xnan <- X[[i]][r,]
Xclean <- X[[i]][!r,]
Xclean = as.matrix(Xclean)
Pclean = x2p(Xclean, perplexity, 1e-05)$P
P[[i]] <- matrix(NA, nrow = nrow(X[[i]]), ncol = nrow(X[[i]]))
#P[[i]][r,] <- Xnan
P[[i]][!r,!r] <- Pclean
}else{
P[[i]] = x2p(X[[i]], perplexity, 1e-05)$P
}
P[[i]] = 0.5 * (P[[i]] + t(P[[i]]))
P[[i]][P[[i]] < eps] <- eps
P[[i]] = P[[i]]/sum(P[[i]], na.rm=T)
P[[i]] = P[[i]] * initial_P_gain
}
#P = lapply(X, function(x) x2p(x,perplexity,1e-05)$P)
grads = matrix(0, nrow(ydata), ncol(ydata))
incs = matrix(0, nrow(ydata), ncol(ydata))
gains = matrix(1, nrow(ydata), ncol(ydata))
for (iter in 1:max_iter) {
if (iter%%epoch == 0) {
total_cost = 0
for (i in 1:M){
temp_cost = 0
temp_cost = sum(apply(P[[i]] * log((P[[i]] + eps)/(Q + eps)), 1,
sum), na.rm=T)
message("Epoch: Iteration #", iter, ", data-view #",i, ", error is: ",
temp_cost)
total_cost = total_cost + temp_cost
}
message("Epoch: Iteration #", iter,  ", total error is: ",
total_cost)
if (total_cost < min_cost)
break
if (!is.null(epoch_callback))
epoch_callback(ydata)
}
sum_ydata = apply(ydata^2, 1, sum)
num = 1/(1 + sum_ydata + sweep(-2 * ydata %*% t(ydata),
2, -t(sum_ydata)))
diag(num) = 0
Q = num/sum(num, na.rm=T)
if (any(is.nan(num))){
message("NaN in grad. descent")
}
Q[Q < eps] = eps
for (i in 1:M){
stiffnesses = 4 * (P[[i]] - Q) * num
if (i==1){
for (j in 1:n) {
if (!any(is.na(X[[i]][j,]))){
grads[j, ] = w[i]*apply(sweep(-ydata, 2, -ydata[j, ]) *
stiffnesses[, j], 2, function(x)sum(x, na.rm = T))
}
}
} else {
for (j in 1:n) {
if (!any(is.na(X[[i]][j,]))){
grads[j, ] = grads[j,] + w[i]*apply(sweep(-ydata, 2, -ydata[j, ]) *
stiffnesses[, j], 2, function(x)sum(x, na.rm = T))
}
}
}
}
gains = ((gains + 0.2) * abs(sign(grads) != sign(incs)) +
gains * 0.8 * abs(sign(grads) == sign(incs)))
gains[gains < min_gain] = min_gain
incs = momentum * incs - epsilon * (gains * grads)
ydata = ydata + incs
ydata = sweep(ydata, 2, apply(ydata, 2, mean))
if (iter == mom_switch_iter)
momentum = final_momentum
for (i in 1:M){
C = sum(P[[i]]*log(P[[i]]/Q), na.rm=T)
if (is.na(C)){
Ctemp[i] <- 0
} else {
Ctemp[i] <- C
}
if (iter == 100 && is.null(initial_config)){
P[[i]] = P[[i]]/4
}
}
if (weightUpdating == TRUE){
wc = Ctemp
if (sum(wc, na.rm=T)==0){
wc <- rep(1,M)
}
wc <- wc/sum(wc, na.rm=T)
w <- 1-wc
w <- w/sum(w, na.rm=T)
} else{
w <- rep(1,M)
w <- w/sum(, na.rm=T)
}
Weights[iter,] <- w
Errors[iter,] <- Ctemp
}
return(list("Y" = ydata, "Weights" = Weights, "Errors" = Errors))
}
Y <- SmultiSNE(X, max_iter = 100, epoch=10)
true_labels <- c(rep(2,500), rep(3,250))
missing_labels <- true_labels
missing_labels[nan_index] <- 1
par(mfrow=c(1,2))
plot(Y$Y, col = true_labels, pch=19)
plot(Y$Y, col = missing_labels, pch=19)
Y <- SmultiSNE(X, max_iter = 500, epoch=10)
true_labels <- c(rep(2,500), rep(3,250))
missing_labels <- true_labels
missing_labels[nan_index] <- 1
par(mfrow=c(1,2))
plot(Y$Y, col = true_labels, pch=19)
plot(Y$Y, col = missing_labels, pch=19)
xx <- prcomp(X[[1]])
plot(xx$x)
plot(xx$x, col=true_labels)
X[[1]] <- X[[1]]^2
X[[1]] <- X[[1]]^2+rnorm(1)^5
xx <- prcomp(X[[1]])
plot(xx$x, col=true_labels)
X[[1]] <- exp(X[[1]]^2+rnorm(1)^5)
xx <- prcomp(X[[1]])
plot(xx$x, col=true_labels)
X[[1]] <- scale(X[[1]])
xx <- prcomp(X[[1]])
plot(xx$x, col=true_labels)
Y <- SmultiSNE(X, max_iter = 500, epoch=10)
true_labels <- c(rep(2,500), rep(3,250))
missing_labels <- true_labels
missing_labels[nan_index] <- 1
par(mfrow=c(1,2))
plot(Y$Y, col = true_labels, pch=19)
plot(Y$Y, col = missing_labels, pch=19)
tail(X[[3]])
dim(Y$Y)
# Step 4: Process your documentation
setwd("./multiSNE")
document()
# Step 6 (Bonus): Make the package a GitHub repo
install_github('multiSNE','theorod93')
