#Assume that suitable files are placed under current or suitable sub directories
require(rTensor)
#GSE160224
x <- read.csv("GSE160224_Raw_gene_counts_matrix.csv.gz")
ensembl_to_gene <- read.ods("emselbl_to_gene.ods",sheet=1)
save(file="ensembl_to_gene",ensembl_to_gene)
#GSE155567
x1 <- read.csv("GSE155567_Raw_gene_counts_matrix.csv.gz")
index <- match(x1[,1],x[,1])
x_all <-x[index,-1] 
x_all[is.na(x_all)]<-0
x_all <- scale(x_all)
x_all_1 <- scale(x1[,-1])
SVD <- svd(x_all)
SVD1 <- svd(x_all_1)
#GSE162873
x2<- read.delim("GSE162873_readcount_AD2.txt.gz")
x3<- read.delim("GSE162873_readcount_AD1.txt.gz")
index2 <- match(x1[,1],x2[,1])
index3 <- match(x1[,1],x3[,1])
x_all_2 <- cbind(x2[index2,2:3],x3[index3,2:7])
x_all_2[is.na(x_all_2)] <-0
x_all_2 <- scale(x_all_2)
SVD2<- svd(x_all_2)
K<-8
COR <- matrix(NA,3,K)
COR[1,] <- diag(cor(SVD$u,SVD$u))[1:K]
COR[2,] <- diag(cor(SVD$u,SVD1$u))[1:K]
COR[3,] <- diag(cor(SVD$u,SVD2$u))[1:K]

COR <- sign(COR)
for (j in c(1:K))
{
    SVD$u[,j]<- COR[1,j]*SVD$u[,j]
    SVD$v[,j]<- COR[1,j]*SVD$v[,j]
    SVD1$u[,j]<- COR[2,j]*SVD1$u[,j]
    SVD1$v[,j]<- COR[2,j]*SVD1$v[,j]
    SVD2$u[,j]<- COR[3,j]*SVD2$u[,j]
    SVD2$v[,j]<- COR[3,j]*SVD2$v[,j]
}
# integrated analysis of datasets 1, 2, and 3
Z <- array(NA,c(dim(x_all)[1],K,3))
Z[,,1] <-  x_all %*% SVD$v[,1:K]
Z[,,2] <- x_all_1 %*% SVD1$v[,1:K]
Z[,,3] <- x_all_2%*% SVD2$v[,1:K]
HOSVD <- hosvd(as.tensor(Z),c(10,K,3))
#Projection onto space spanned by sigular value vectors
B <- t(cbind(x_all,x_all_1,x_all_2)) %*% HOSVD$U[[1]][,1:5]
#test the coincidence with classification
#for Dataset 1
t.test(B[1:3,1],B[4:9,1])
#for Dataset 2
summary(lm(B[10:32,1]~factor(c(rep(1,6),rep(2,6),rep(3,5),rep(4,6)))))
summary(lm(B[10:32,2]~factor(c(rep(1,6),rep(2,6),rep(3,5),rep(4,6)))))
summary(lm(B[10:32,3]~factor(c(rep(1,6),rep(2,6),rep(3,5),rep(4,6)))))
summary(lm(B[10:32,4]~factor(c(rep(1,6),rep(2,6),rep(3,5),rep(4,6)))))
summary(lm(B[10:32,5]~factor(c(rep(1,6),rep(2,6),rep(3,5),rep(4,6)))))
#for Dataset 3
summary(lm(B[33:40,1]~factor(c(rep(1,2),rep(2,2),rep(3,4)))))
summary(lm(B[33:40,2]~factor(c(rep(1,2),rep(2,2),rep(3,4)))))
summary(lm(B[33:40,4]~factor(c(rep(1,2),rep(2,2),rep(3,4)))))
summary(lm(B[33:40,5]~factor(c(rep(1,2),rep(2,2),rep(3,4)))))
#Genarate a table of G
rowSums(apply(HOSVD$Z@data[,1:3,]^2,c(1,3),sum))
#Count the nubmer of genes selected
P <- pchisq(rowSums(scale(HOSVD$U[[1]][,1:5])^2),5,lower.tail=F)
table(p.adjust(P,"BH")<0.01)
#List genes
x1[p.adjust(P,"BH")<0.01,1]
#Drug discovery
#GSE164788
sample <- read.csv("sample.csv")
sample <- t(data.frame(strsplit(apply(sample[,2,drop=F],2,as.character)," RNA-seq of ReNcell VM treated with ")))
rownames(sample) <- NULL
colnames(sample) <- NULL
x4 <- read.delim("GSE164788_deduplicated_counts.csv.gz")
save(file="x4",x4)
index <- sample[,2] %in% names(table(sample[,2]))[1:length(names(table(sample[,2]))) %in% grep(" uM ",names(table(sample[,2]))) & table(sample[,2])>=3]
sample <- sample[index,]
sample <- data.frame(sample[,1],t(data.frame(strsplit(sample[,2]," uM "))))
rownames(sample) <- NULL
colnames(sample) <- NULL
drugs <- rownames(table(sample[,3],sample[,2]))
dose <- sort(as.numeric(colnames(table(sample[,3],sample[,2]))))
x4 <- x4[x4[,1] %in% sample[,1],]
TABLE <- table(x4[,2],x4[,1])
genes <- rownames(TABLE)
Z4 <- array(0,c(length(genes),length(drugs),length(dose),3))
for (i in c(1:length(drugs))){
    cat("\n i:",i," ")
    for (j in c(1:length(dose)))
    {
        cat(j," ")
        ID <- unlist(unique(sample[sample[,2]==dose[j]&sample[,3]==drugs[i],1]))[1:3]
        ID <- as.character(ID)
        if (sum(!is.na(ID))!=0)
        {
            for (k in 1:3)
            {
                Z4[,i,j,k]<-x4[x4[,1]==ID[k],][match(genes,x4[x4[,1]==ID[k],2]),3]
            }
        }
    }
}
Z4[is.na(Z4)] <-0
Z4 <- apply(Z4,2:4,scale)
Z4[is.na(Z4)] <-0
HOSVD0 <- hosvd(as.tensor(Z4),c(10,94,4,3))

Z0 <- ttm(as.tensor(Z4),t(HOSVD0$U[[2]][,1:4]),2)
Z0 <- ttm(Z0,t(HOSVD0$U[[3]][,3:4]),3)
Z0 <- ttm(Z0,t(HOSVD0$U[[4]][,1]),4)
index4 <- match(x1[,1],genes)
Z0 <- k_unfold(Z0,1)[index4,]
Z0@data[is.na(Z0@data)]<-0
K<-8
Z <- array(NA,c(dim(x_all)[1],K,4))
Z[,,1] <-  x_all %*% SVD$v[,1:K]
Z[,,2] <- x_all_1 %*% SVD1$v[,1:K]
Z[,,3] <- x_all_2%*% SVD2$v[,1:K]
Z <- as.tensor(Z)
Z[,,4] <- Z0
HOSVD <- hosvd(Z,c(10,K,4))
#Projection onto space spanned by sigular value vectors
ZZ <-Z4
dim(ZZ) <- c(28044,94*4*3)
ZZZ<- array(NA,c(dim(x_all)[1],94*4*3))
ZZZ<- ZZ[index4,]
ZZZ[is.na(ZZZ)]<-0
B <- t(cbind(x_all,x_all_1,x_all_2,ZZZ)) %*% HOSVD$U[[1]][,1:5]
#test the coincidence with classification
#for Dataset 1
t.test(B[1:3,1],B[4:9,1])
#for Data Set 2
summary(lm(B[10:32,1]~factor(c(rep(1,6),rep(2,6),rep(3,5),rep(4,6)))))
summary(lm(B[10:32,2]~factor(c(rep(1,6),rep(2,6),rep(3,5),rep(4,6)))))
summary(lm(B[10:32,3]~factor(c(rep(1,6),rep(2,6),rep(3,5),rep(4,6)))))
summary(lm(B[10:32,4]~factor(c(rep(1,6),rep(2,6),rep(3,5),rep(4,6)))))
summary(lm(B[10:32,5]~factor(c(rep(1,6),rep(2,6),rep(3,5),rep(4,6)))))
#for Data set 3
summary(lm(B[33:40,1]~factor(c(rep(1,2),rep(2,2),rep(3,4)))))
summary(lm(B[33:40,2]~factor(c(rep(1,2),rep(2,2),rep(3,4)))))
summary(lm(B[33:40,3]~factor(c(rep(1,2),rep(2,2),rep(3,4)))))
#selecting Drugs
ZB <-B[41:1168,]
dim(ZB)<-c(94,4,3,5)
#l=1 to 5 
HOSVD <- hosvd(as.tensor(ZB[,,,l]))
drugs[order(-rowSums(HOSVD$U[[1]][,1:5]^2))][1:5]
#Genarate a table of G
apply(HOSVD$Z@data[,1:4,]^2,c(1,3),sum)
#Count the nubmer of genes selected
P <- pchisq(rowSums(scale(HOSVD$U[[1]][,1:5])^2),5,lower.tail=F)
table(p.adjust(P,"BH")<0.01)
#List genes
x1[p.adjust(P,"BH")<0.01,1]
#Transfer Learning
#GSE164642
files <- list.files("./",pattern="txt.gz")
xp <- read.delim(files[1], comment.char="#")
Z5 <- array(NA,c(dim(xp)[1],3,2,3))
for (k in 1:3){
    for (j in 1:2){
        for (i in 1:3)
        {
            l=i + (j-1)*3 + (k-1)*2*3
            cat(l," ")
            xp <- read.delim(files[l], comment.char="#")
            Z5[,i,j,k] <- xp[,7]
            #print(paste(i,j,k,files[l]))
        }
    }
}
save(file="Z5",Z5)
Z5 <- apply(Z5,2:4,scale)
HOSVD0P <- hosvd(as.tensor(Z5),c(10,3,2,3))


Z0P <- ttm(as.tensor(Z5),t(HOSVD0P$U[[2]][,1:2]),2)
Z0P <- ttm(Z0P,t(HOSVD0P$U[[3]][,1:2]),3)
Z0P <- ttm(Z0P,t(HOSVD0P$U[[4]][,1:2]),4)
index5 <- match(x1[,1],xp[,1])
Z0P <- k_unfold(Z0P,1)[index5,]
Z0P@data[is.na(Z0P@data)]<-0

K<-8
Z <- array(NA,c(dim(x_all)[1],K,4))
Z[,,1] <-  x_all %*% SVD$v[,1:K]
Z[,,2] <- x_all_1 %*% SVD1$v[,1:K]
Z[,,3] <- x_all_2%*% SVD2$v[,1:K]
Z <- as.tensor(Z)
Z[,,4] <- Z0P
HOSVD <- hosvd(Z,c(10,K,4))
#Projection onto space spanned by sigular value vectors
ZZ <-Z5
dim(ZZ) <- c(58003,3*2*3)
ZZZ<- array(NA,c(dim(x_all)[1],3*2*3))
ZZZ<- ZZ[index5,]
ZZZ[is.na(ZZZ)]<-0
B <- t(cbind(x_all,x_all_1,x_all_2,ZZZ)) %*% HOSVD$U[[1]][,1:5]
#test the coincidence with classification
#for data set 1
t.test(B[1:3,1],B[4:9,1])
#for data set 2
summary(lm(B[10:32,1]~factor(c(rep(1,6),rep(2,6),rep(3,5),rep(4,6)))))
summary(lm(B[10:32,2]~factor(c(rep(1,6),rep(2,6),rep(3,5),rep(4,6)))))
summary(lm(B[10:32,3]~factor(c(rep(1,6),rep(2,6),rep(3,5),rep(4,6)))))
summary(lm(B[10:32,4]~factor(c(rep(1,6),rep(2,6),rep(3,5),rep(4,6)))))
summary(lm(B[10:32,5]~factor(c(rep(1,6),rep(2,6),rep(3,5),rep(4,6)))))
#for data set 3
summary(lm(B[33:40,1]~factor(c(rep(1,2),rep(2,2),rep(3,4)))))
summary(lm(B[33:40,2]~factor(c(rep(1,2),rep(2,2),rep(3,4)))))
summary(lm(B[33:40,3]~factor(c(rep(1,2),rep(2,2),rep(3,4)))))
summary(lm(B[33:40,5]~factor(c(rep(1,2),rep(2,2),rep(3,4)))))
#for data set 5
summary(lm(B[41:58,1]~factor(outer(outer(rep(1,3),1:2),c(1,3,5),"+"))))
summary(lm(B[41:58,2]~factor(outer(outer(rep(1,3),1:2),c(1,3,5),"+"))))
summary(lm(B[41:58,3]~factor(outer(outer(rep(1,3),1:2),c(1,3,5),"+"))))
summary(lm(B[41:58,4]~factor(outer(outer(rep(1,3),1:2),c(1,3,5),"+"))))
summary(lm(B[41:58,5]~factor(outer(outer(rep(1,3),1:2),c(1,3,5),"+"))))
#Genarate a table of G
apply(HOSVD$Z@data[,c(1,3:5),]^2,c(1,3),sum)
#Count the nubmer of genes selected
P <- pchisq(rowSums(scale(HOSVD$U[[1]][,1:5])^2),5,lower.tail=F)
table(p.adjust(P,"BH")<0.01)
#List genes
x1[p.adjust(P,"BH")<0.01,1]
#scRNA-seq
#Assume 25 scRNA-seq profiles are placed under subdirectories named as, e.g., "./01_06_C_filtered_feature_bc_matrix/"
require(Matrix)
dirs <- list.files("./",pattern="bc_matrix")
dirs <- paste("./",dirs,"/",sep="")
mat_all <- rep(list(NA),length(dirs))
for (i in c(1:length(dirs)))
{
    cat(i," ")
    matrix_dir = dirs[i]
    barcode.path <- paste0(matrix_dir, "barcodes.tsv.gz")
    features.path <- paste0(matrix_dir, "features.tsv.gz")
    matrix.path <- paste0(matrix_dir, "matrix.mtx.gz")
    mat <- readMM(file = matrix.path)
    feature.names = read.delim(features.path,
                               header = FALSE,
                               stringsAsFactors = FALSE)
    barcode.names = read.delim(barcode.path,
                               header = FALSE,
                               stringsAsFactors = FALSE)
    colnames(mat) = barcode.names$V1
    rownames(mat) = feature.names$V1
    mat_all[[i]]<-mat
}
save(file="mat_all",mat_all)
require(irlba)
SVD_all <- rep(list(NA),length(dirs))
K<-10
for (i in c(1:length(dirs)))
{
    cat(i, " ")
    SVD_all[[i]] <- irlba(mat_all[[i]],K)    
}
save(file="SVD_all",SVD_all)
COR <- matrix(NA,length(dirs),K)
for (i in c(1:length(dirs)))
{
    cat(i, " ")
    COR[i,] <- diag(cor(SVD_all[[1]]$u,SVD_all[[i]]$u))
}
COR <- sign(COR)
for (i in c(1:length(dirs)))
{
    cat(i, " ")
    for (j in c(1:K))
    {
        SVD_all[[i]]$u[,j]<- COR[i,j]*SVD_all[[i]]$u[,j]
        SVD_all[[i]]$v[,j]<- COR[i,j]*SVD_all[[i]]$v[,j]
    }
}
Z <- array(NA,c(dim(mat_all[[1]])[1],K,length(dirs)))
for (i in c(1:length(dirs)))
{
    cat(i, " ")
    Z[,,i] <- as.matrix(mat_all[[i]] %*% SVD_all[[i]]$v[,1:K]) 
}
for (i in 1:length(dirs))
{
    Z[,,i] <- Z[,,i]/mean(Z[,,i])
}
require(rTensor)
HOSVD <- hosvd(as.tensor(Z),c(10,K,length(dirs)))
#test the significance with the distinction between AD and cotrols
labels<-unlist(lapply(strsplit(dirs,"_"),"[",3))
labels[17] <-"AD"
labels[c(18:20,24)]<-paste("C_",labels[c(18:20,24)],sep="")
labels[c(21:23,25)]<-paste("AD_",labels[c(21:23,25)],sep="")
LM <- lm(HOSVD$U[[3]]~factor(labels))
SLM <- summary(LM)
fs <- t(data.frame(lapply(SLM,"[",10)))
P <- pf(fs[,1],fs[,2],fs[,3],lower.tail=F)
table(p.adjust(P,"BH")<0.05)
which(p.adjust(P,"BH")<0.05)
#Count the nubmer of genes selected
P <- pchisq(scale(HOSVD$U[[1]][,6])^2,1,lower.tail=F)
table(p.adjust(P,"BH")<0.01)
#List genes selected
data.frame(rownames(mat_all[[1]])[p.adjust(P,"BH")<0.01])