mod <- btpermute(contests = kenyachoice$contests,
predictors = kenyachoice$predictors,
n.iterations = 10,
seed = 1)
mod
str(mod)
mod$model$coefficients
?btpermute
btpermute
devtools::install_github("meichendong/SCDC")
install.packages("backports")
devtools::install_github("meichendong/SCDC")
devtools::install_github("meichendong/SCDC")
setwd("C:/Users/meichen/OneDrive - University of North Carolina at Chapel Hill/994/SCDC/package/SCDC2/SCDC") # THE OLD PATH HAS ERROR TO UPDATE TO GITHUB
devtools::document()
install.packages("backports")
devtools::document()
setwd("..")
devtools::install("SCDC")
library(SCDC)
setwd("C:/Users/meichen/OneDrive - University of North Carolina at Chapel Hill/994/SCDC/package/SCDC2/SCDC") # THE OLD PATH HAS ERROR TO UPDATE TO GITHUB
pkgdown::build_site()
library(MuSiC)
library(Biobase)
library(bseqsc)
library(plyr)
library(xbioc)
library(nnls)
library(reshape)
library(grid)
library(L1pack)
bulk10x <- readRDS("S0102_peroubulk10x_fvb34.rds")
setwd("C:/Users/meichen/OneDrive - University of North Carolina at Chapel Hill/994/SCDC/data")
library(SCDC)
library(Biobase)
bulk10x <- readRDS("S0102_peroubulk10x_fvb34.rds")
setwd("C:/Users/meichen/OneDrive - University of North Carolina at Chapel Hill/994/SCDC/data")
library(SCDC)
library(Biobase)
bulk10x <- readRDS("S0102_peroubulk10x_fvb34.rds")
qc.perou<- readRDS("qc_perou.rds")
qc.perou<- readRDS("S0103_QCPEROU.rds")
qc.tmouse<- readRDS("S0103_QCTMOUSE.rds")
perou <- qc.perou$sc.eset.qc
tmouse <- qc.tmouse$sc.eset.qc
perou$metacluster2[perou$md_cluster %in% c( "immune")] <- "immune"
perou$metacluster2[perou$md_cluster %in% c("basal","luminal","fibroblast","endothelial")] <- "BaLuFibEndo"
perou.subcl <- SCDC_prop_subcl_marker(bulk.eset = bulk10x, sc.eset = perou, ct.varname = "md_cluster", fl.varname = "metacluster2", sample = "subj", ct.sub = c("endothelial","fibroblast","immune","luminal","basal"), ct.fl.sub = unique(perou$metacluster2), select.marker = T, LFC.lim = 5)
tmouse$metacluster2[tmouse$md_cluster %in% c("immune")] <- "immune"
tmouse$metacluster2[tmouse$md_cluster %in% c("endothelial", "fibroblast","luminal","basal")] <- "BaLuFibEndo"
tmouse.subcl <- SCDC_prop_subcl_marker(bulk.eset = bulk10x, sc.eset = tmouse, ct.varname = "md_cluster", fl.varname = "metacluster2", sample = "subj", ct.sub = c("endothelial","fibroblast","immune","luminal","basal"), ct.fl.sub = unique(tmouse$metacluster2), select.marker = T, LFC.lim = 5)
ens_subcl_perou10x <- SCDC_ENSEMBLE(bulk.eset = bulk10x, prop.input = list(tmouse.subcl = tmouse.subcl, perou.subcl = perou.subcl), ct.sub = c("endothelial","fibroblast","immune","luminal","basal"), search.length = 0.01, grid.search = T)
ens_subcl_perou10x$w_table
getPearson <- function(dt1, dt2, ct, subj){
cor(c(dt1[subj,ct]), c(dt2[subj,ct]))
}
ens_res <- function(wt, proplist, subject = c("FVB3","FVB4")){
ens <- wt_prop(wt, proplist = proplist)
p.ens <- getPearson(perou_pseudo_all$truep, ens ,
ct = c("endothelial","fibroblast","luminal","basal","immune"), subj = subject)
return(list(prop = ens, p = p.ens))
}
combo.10x <- lapply(ens_subcl_perou10x$prop.list, function(x){
x$prop.est[,c("endothelial","fibroblast","luminal","basal","immune")]
})
library(ggplot2)
library(reshape2)
ct1 <- c("mediumorchid1","mediumpurple1","lightskyblue","seagreen1","yellow","tan1","azure3")
perou_pseudo_all <- generateBulk_allcells(perou, ct.varname = 'md_cluster', sample = 'subj', ct.sub = c("endothelial","fibroblast","immune","luminal","basal"))
getENSplot <- function(enstable, combo, subject, subcat = NULL){
if (!is.null(subcat)){
enstable <- enstable[subcat,]
}
wtres.list <- list()
for (i in 1:nrow(enstable)){
wtres.list[[i]] <- ens_res(enstable[i,1:2], combo)$prop
}
names(wtres.list) <- rownames(enstable)
pcor.list <- NULL
for (i in 1:nrow(enstable)){
pcor.list[[i]] <- ens_res(enstable[i,1:2], combo, subject = subject)$p
}
names(pcor.list) <- rownames(enstable)
est.all <- rbind(perou_pseudo_all$truep[,c("endothelial","fibroblast","luminal","basal","immune")],
do.call(rbind, combo),
do.call(rbind, wtres.list))
est.all.3 <- est.all[rownames(est.all) == subject,]
rownames(est.all.3) <- as.factor(c("Seurat", "Tabula Muris", "Perou",
paste("ENSEMBLE:",names(pcor.list))))
p_t <- getPearson(perou_pseudo_all$truep, combo[[1]],
ct = c("endothelial","fibroblast","luminal","basal","immune"), subj = c(subject))
p_p <- getPearson(perou_pseudo_all$truep, combo[[2]],
ct = c("endothelial","fibroblast","luminal","basal","immune"), subj = c(subject))
dat_text <- data.frame(label = c("",paste("R=", round(c(p_t, p_p, pcor.list),2), sep = "")),
Var1 = as.factor(c("Seurat", "Tabula Muris", "Perou",
paste("ENSEMBLE:",names(pcor.list)))),
value =rep(0.9, length(pcor.list)+3),
Var2 = rep("endothelial",length(pcor.list)+3))
meltdt <- melt(est.all.3)
P <- ggplot(meltdt, aes(x=Var1, y=value, fill = factor(Var2, levels = c("endothelial","fibroblast","luminal","basal","immune")))) +
geom_bar(stat = "identity") + xlab("") + ylab("Percentage") +
theme(axis.text.x = element_text(angle = 30, hjust = 1, size=10),
axis.text.y = element_text(size = 10),
text = element_text(size = 10),
plot.title = element_text(size=10, face = "bold"),
plot.margin=unit(c(1,1,-5,0), "mm"),
legend.position="top",legend.title = element_blank(),
legend.text = element_text(size=8),
legend.box.spacing = unit(0, "mm"),
panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"))+
scale_fill_manual(values=ct1) +
guides(fill = guide_legend(nrow = 2))+
# facet_grid(cols = vars(ref)) +
geom_text(data = dat_text,
mapping = aes(x=Var1, y=value,label = label),
hjust   = 0.5, vjust   = 0)
# png(file.path(vpath,  "mammarygland.png"), res = 80, height = 300, width = 300)
print(P)
# dev.off()
}
getENSplot(enstable = ens_subcl_perou10x$w_table, combo=combo.10x, subject = "FVB3", subcat = c("Spearman_Y","LAD"))
enstable = ens_subcl_perou10x$w_table
combo=combo.10x
subject = "FVB3"
subcat = c("Spearman_Y","LAD")
if (!is.null(subcat)){
enstable <- enstable[subcat,]
}
wtres.list <- list()
for (i in 1:nrow(enstable)){
wtres.list[[i]] <- ens_res(enstable[i,1:2], combo)$prop
}
names(wtres.list) <- rownames(enstable)
pcor.list <- NULL
for (i in 1:nrow(enstable)){
pcor.list[[i]] <- ens_res(enstable[i,1:2], combo, subject = subject)$p
}
names(pcor.list) <- rownames(enstable)
est.all <- rbind(perou_pseudo_all$truep[,c("endothelial","fibroblast","luminal","basal","immune")],
do.call(rbind, combo),
do.call(rbind, wtres.list))
est.all.3 <- est.all[rownames(est.all) == subject,]
rownames(est.all.3) <- as.factor(c("Seurat", "Tabula Muris", "Perou",
paste("ENSEMBLE:",names(pcor.list))))
p_t <- getPearson(perou_pseudo_all$truep, combo[[1]],
ct = c("endothelial","fibroblast","luminal","basal","immune"), subj = c(subject))
p_p <- getPearson(perou_pseudo_all$truep, combo[[2]],
ct = c("endothelial","fibroblast","luminal","basal","immune"), subj = c(subject))
dat_text <- data.frame(label = c("",paste("R=", round(c(p_t, p_p, pcor.list),2), sep = "")),
Var1 = as.factor(c("Seurat", "Tabula Muris", "Perou",
paste("ENSEMBLE:",names(pcor.list)))),
value =rep(0.9, length(pcor.list)+3),
Var2 = rep("endothelial",length(pcor.list)+3))
p_t
p_p
dat_text <- data.frame(label = c("",paste("R=", round(c(p_t, p_p, pcor.list),2), sep = "")),
Var1 = as.factor(c("Seurat", "Tabula Muris", "Perou",
paste("ENSEMBLE:",names(pcor.list)))),
value =rep(0.9, length(pcor.list)+3),
Var2 = rep("endothelial",length(pcor.list)+3))
perou_pseudo_all$truep, combo[[1]]
perou_pseudo_all
combo[[1]]
perou_pseudo_all$truep
p_t <- getPearson(perou_pseudo_all$truep[,colnames(combo[[1]])], combo[[1]],
ct = c("endothelial","fibroblast","luminal","basal","immune"), subj = c(subject))
p_t
p_p <- getPearson(perou_pseudo_all$truep[,colnames(combo[[2]])], combo[[2]],
ct = c("endothelial","fibroblast","luminal","basal","immune"), subj = c(subject))
p_p
pcor.list
dat_text <- data.frame(label = c("",paste("R=", round(c(p_t, p_p, unlist(pcor.list)),2), sep = "")),
Var1 = as.factor(c("Seurat", "Tabula Muris", "Perou",
paste("ENSEMBLE:",names(pcor.list)))),
value =rep(0.9, length(pcor.list)+3),
Var2 = rep("endothelial",length(pcor.list)+3))
dat_text
meltdt <- melt(est.all.3)
ggplot(meltdt, aes(x=Var1, y=value, fill = factor(Var2, levels = c("endothelial","fibroblast","luminal","basal","immune")))) +
geom_bar(stat = "identity") + xlab("") + ylab("Percentage") +
theme(axis.text.x = element_text(angle = 30, hjust = 1, size=10),
axis.text.y = element_text(size = 10),
text = element_text(size = 10),
plot.title = element_text(size=10, face = "bold"),
plot.margin=unit(c(1,1,-5,0), "mm"),
legend.position="top",legend.title = element_blank(),
legend.text = element_text(size=8),
legend.box.spacing = unit(0, "mm"),
panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"))+
scale_fill_manual(values=ct1) +
guides(fill = guide_legend(nrow = 2))+
# facet_grid(cols = vars(ref)) +
geom_text(data = dat_text,
mapping = aes(x=Var1, y=value,label = label),
hjust   = 0.5, vjust   = 0)
ggplot(meltdt, aes(x=Var1, y=value, fill = factor(Var2, levels = c("endothelial","fibroblast","luminal","basal","immune")))) +
geom_bar(stat = "identity") + xlab("") + ylab("Percentage") +
theme(axis.text.x = element_text(angle = 30, hjust = 1, size=10),
axis.text.y = element_text(size = 10),
text = element_text(size = 10),
plot.title = element_text(size=10, face = "bold"),
plot.margin=unit(c(1,1,-5,0), "mm"),
legend.position="top",legend.title = element_blank(),
legend.text = element_text(size=8),
legend.box.spacing = unit(0, "mm"),
panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"))+
scale_fill_manual(values=ct1) +
guides(fill = guide_legend(nrow = 2))+
# facet_grid(cols = vars(ref)) +
geom_text(data = dat_text,
mapping = aes(x=Var1, y=value,label = label),
hjust   = 0.5, vjust   = 0)
qc.perou<- readRDS("S0103_QCPEROU.rds")
qc.perou<- readRDS("qc_perou.rds")
perou <- qc.perou$sc.eset.qc
perou.subcl$prop.est
tmouse.subcl$prop.est
tmouse$metacluster2[tmouse$md_cluster %in% c("immune")] <- "immune"
tmouse.subcl$prop.est
ens_subcl_perou10x$w_table
getPearson <- function(dt1, dt2, ct, subj){
cor(c(dt1[subj,ct]), c(dt2[subj,ct]))
}
ens_res <- function(wt, proplist, subject = c("FVB3","FVB4")){
ens <- wt_prop(wt, proplist = proplist)
p.ens <- getPearson(perou_pseudo_all$truep, ens ,
ct = c("endothelial","fibroblast","luminal","basal","immune"), subj = subject)
return(list(prop = ens, p = p.ens))
}
combo.10x <- lapply(ens_subcl_perou10x$prop.list, function(x){
x$prop.est[,c("endothelial","fibroblast","luminal","basal","immune")]
})
combo.10x$tmouse.subcl
combo.10x$tmouse.subcl
ens_subcl_perou10x$prop.list
str(ens_subcl_perou10x$prop.list)
ens_subcl_perou10x$prop.list$tmouse.subcl$prop.est
ens_subcl_perou10x$prop.list$perou.subcl$prop.est
combo.10x
perou_pseudo_all$truep
tmouse.subcl <- SCDC_prop_subcl_marker(bulk.eset = bulk10x, sc.eset = tmouse, ct.varname = "md_cluster", fl.varname = "metacluster2", sample = "subj",
ct.sub = c("endothelial","fibroblast","immune","luminal","basal"),
ct.fl.sub = unique(tmouse$metacluster2), select.marker = T, LFC.lim = 5, weight.basis = F)
tmouse.subcl$prop.est
perou.subcl <- SCDC_prop_subcl_marker(bulk.eset = bulk10x, sc.eset = perou, ct.varname = "md_cluster", fl.varname = "metacluster2", sample = "subj",
ct.sub = c("endothelial","fibroblast","immune","luminal","basal"),
ct.fl.sub = unique(perou$metacluster2), select.marker = T, LFC.lim = 5, weight.basis = F)
bulk.eset = bulk10x
sc.eset = perou
ct.varname = "md_cluster"
fl.varname = "metacluster2"
sample = "subj"
ct.sub = c("endothelial","fibroblast","immune","luminal","basal")
ct.fl.sub = unique(perou$metacluster2)
select.marker = T
LFC.lim = 5
weight.basis = F
SCDC_prop_subcl_marker
if (is.null(ct.sub)) {
ct.sub <- unique(sc.eset@phenoData@data[, ct.varname])[!is.na(unique(sc.eset@phenoData@data[,
ct.varname]))]
}
ct.sub <- ct.sub[!is.na(ct.sub)]
ct.sub
ct.fl.sub <- ct.fl.sub[!is.na(ct.fl.sub)]
ct.fl.sub
ct.varname = "md_cluster"
fl.varname = "metacluster2"
ct.fl.sub <- ct.fl.sub[!is.na(ct.fl.sub)]
ct.fl.sub
ct.fl.sub
ct.fl.sub = unique(perou$metacluster2)
ct.fl.sub
perou$metacluster2[perou$md_cluster %in% c( "immune")] <- "immune"
perou$metacluster2[perou$md_cluster %in% c("basal","luminal","fibroblast","endothelial")] <- "BaLuFibEndo"
perou.subcl <- SCDC_prop_subcl_marker(bulk.eset = bulk10x, sc.eset = perou, ct.varname = "md_cluster", fl.varname = "metacluster2", sample = "subj",
ct.sub = c("endothelial","fibroblast","immune","luminal","basal"),
ct.fl.sub = unique(perou$metacluster2), select.marker = T, LFC.lim = 5, weight.basis = F)
perou.subcl$prop.est
perou.subcl <- SCDC_prop_subcl_marker(bulk.eset = bulk10x, sc.eset = perou, ct.varname = "md_cluster", fl.varname = "metacluster2", sample = "subj",
ct.sub = c("endothelial","fibroblast","immune","luminal","basal"),
ct.fl.sub = unique(perou$metacluster2), select.marker = T, LFC.lim = 4)
perou.subcl$prop.est
perou.subcl <- SCDC_prop_subcl_marker(bulk.eset = bulk10x, sc.eset = perou, ct.varname = "md_cluster", fl.varname = "metacluster2", sample = "subj",
ct.sub = c("endothelial","fibroblast","immune","luminal","basal"),
ct.fl.sub = unique(perou$metacluster2), select.marker = T, LFC.lim = 3)
perou.subcl$prop.est
tmouse.subcl <- SCDC_prop_subcl_marker(bulk.eset = bulk10x, sc.eset = tmouse, ct.varname = "md_cluster", fl.varname = "metacluster2", sample = "subj",
ct.sub = c("endothelial","fibroblast","immune","luminal","basal"),
ct.fl.sub = unique(tmouse$metacluster2), select.marker = T, LFC.lim = 3, weight.basis = F)
tmouse.subcl$prop.est
ens_subcl_perou10x <- SCDC_ENSEMBLE(bulk.eset = bulk10x, prop.input = list(tmouse.subcl = tmouse.subcl, perou.subcl = perou.subcl), ct.sub = c("endothelial","fibroblast","immune","luminal","basal"), search.length = 0.01, grid.search = T)
ens_subcl_perou10x$w_table
getPearson <- function(dt1, dt2, ct, subj){
cor(c(dt1[subj,ct]), c(dt2[subj,ct]))
}
ens_res <- function(wt, proplist, subject = c("FVB3","FVB4")){
ens <- wt_prop(wt, proplist = proplist)
p.ens <- getPearson(perou_pseudo_all$truep, ens ,
ct = c("endothelial","fibroblast","luminal","basal","immune"), subj = subject)
return(list(prop = ens, p = p.ens))
}
combo.10x <- lapply(ens_subcl_perou10x$prop.list, function(x){
x$prop.est[,c("endothelial","fibroblast","luminal","basal","immune")]
})
combo.10x$tmouse.subcl
combo.10x$tmouse.subcl
combo.10x$perou.subcl
getENSplot <- function(enstable, combo, subject, subcat = NULL){
if (!is.null(subcat)){
enstable <- enstable[subcat,]
}
wtres.list <- list()
for (i in 1:nrow(enstable)){
wtres.list[[i]] <- ens_res(enstable[i,1:2], combo)$prop
}
names(wtres.list) <- rownames(enstable)
pcor.list <- NULL
for (i in 1:nrow(enstable)){
pcor.list[[i]] <- ens_res(enstable[i,1:2], combo, subject = subject)$p
}
names(pcor.list) <- rownames(enstable)
est.all <- rbind(perou_pseudo_all$truep[,c("endothelial","fibroblast","luminal","basal","immune")],
do.call(rbind, combo),
do.call(rbind, wtres.list))
est.all.3 <- est.all[rownames(est.all) == subject,]
rownames(est.all.3) <- as.factor(c("Seurat", "Tabula Muris", "Perou",
paste("ENSEMBLE:",names(pcor.list))))
p_t <- getPearson(perou_pseudo_all$truep[,colnames(combo[[1]])], combo[[1]],
ct = c("endothelial","fibroblast","luminal","basal","immune"), subj = c(subject))
p_p <- getPearson(perou_pseudo_all$truep[,colnames(combo[[2]])], combo[[2]],
ct = c("endothelial","fibroblast","luminal","basal","immune"), subj = c(subject))
dat_text <- data.frame(label = c("",paste("R=", round(c(p_t, p_p, unlist(pcor.list)),2), sep = "")),
Var1 = as.factor(c("Seurat", "Tabula Muris", "Perou",
paste("ENSEMBLE:",names(pcor.list)))),
value =rep(0.9, length(pcor.list)+3),
Var2 = rep("endothelial",length(pcor.list)+3))
meltdt <- melt(est.all.3)
P <- ggplot(meltdt, aes(x=Var1, y=value, fill = factor(Var2, levels = c("endothelial","fibroblast","luminal","basal","immune")))) +
geom_bar(stat = "identity") + xlab("") + ylab("Percentage") +
theme(axis.text.x = element_text(angle = 30, hjust = 1, size=10),
axis.text.y = element_text(size = 10),
text = element_text(size = 10),
plot.title = element_text(size=10, face = "bold"),
plot.margin=unit(c(1,1,-5,0), "mm"),
legend.position="top",legend.title = element_blank(),
legend.text = element_text(size=8),
legend.box.spacing = unit(0, "mm"),
panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"))+
scale_fill_manual(values=ct1) +
guides(fill = guide_legend(nrow = 2))+
# facet_grid(cols = vars(ref)) +
geom_text(data = dat_text,
mapping = aes(x=Var1, y=value,label = label),
hjust   = 0.5, vjust   = 0)
# png(file.path(vpath,  "mammarygland.png"), res = 80, height = 300, width = 300)
print(P)
# dev.off()
}
getENSplot(enstable = ens_subcl_perou10x$w_table, combo=combo.10x, subject = "FVB3", subcat = c("Spearman_Y","LAD"))
tmousesubcl10x <- readRDS("S0204_subcltmouse_3.rds")
tmousesubcl10x$prop.est
tmouse.subcl <- SCDC_prop_subcl_marker(bulk.eset = bulk10x, sc.eset = tmouse, ct.varname = "md_cluster", fl.varname = "metacluster2", sample = "subj",
ct.sub = c("endothelial","fibroblast","immune","luminal","basal"),
ct.fl.sub = unique(tmouse$metacluster2), select.marker = T, LFC.lim = 5)
tmouse.subcl <- SCDC_prop_subcl_marker(bulk.eset = bulk10x, sc.eset = tmouse, ct.varname = "md_cluster", fl.varname = "metacluster2", sample = "subj",
ct.sub = c("endothelial","fibroblast","immune","luminal","basal"),
ct.fl.sub = unique(tmouse$metacluster2), select.marker = T, LFC.lim = 5)
tmouse.subcl$prop.est
tmousesubcl10x$prop.est
subcl.perou3 <- readRDS("S0204_subscperou_3.rds")
subcl.perou3$prop.est
SCDC_basis <- function(x, ct.sub = NULL, ct.varname, sample, ct.cell.size = NULL){
# select only the subset of cell types of interest
if (is.null(ct.sub)){
ct.sub <- unique(x@phenoData@data[,ct.varname])
}
ct.sub <- ct.sub[!is.na(ct.sub)]
x.sub <- x[,x@phenoData@data[,ct.varname] %in% ct.sub]
# qc: remove non-zero genes
x.sub <- x.sub[rowSums(exprs(x.sub)) > 0,]
# calculate sample mean & sample variance matrix: genes by cell types
countmat <- exprs(x.sub)
ct.id <- droplevels(as.factor(x.sub@phenoData@data[,ct.varname]))
sample.id <- as.character(x.sub@phenoData@data[,sample])
ct_sample.id <- paste(ct.id,sample.id, sep = '%')
mean.mat <- sapply(unique(ct_sample.id), function(id){
y = as.matrix(countmat[, ct_sample.id %in% id])
apply(y,1,sum, na.rm = TRUE)/sum(y)
})
mean.id <- do.call('rbind',strsplit(unique(ct_sample.id), split = '%'))
sigma <- sapply(unique(mean.id[, 1]), function(id) {
y = mean.mat[, mean.id[, 1] %in% id]
if (is.null(dim(y))){
res = rep(0, length(y))
message("Warning: the cell type [", id,"] is only available in at most 1 subject!")
} else {
res = apply(y, 1, var, na.rm = TRUE)
}
return(res)
})
sum.mat2 <- sapply(unique(sample.id), function(sid){
sapply(unique(ct.id), function(id){
y = as.matrix(countmat[, ct.id %in% id & sample.id %in% sid])
sum(y)/ncol(y)
})
})
rownames(sum.mat2) <- unique(ct.id)
colnames(sum.mat2) <- unique(sample.id)
# library size factor calculated from the samples:
if (is.null(ct.cell.size)){
sum.mat <- rowMeans(sum.mat2, na.rm = T)
} else {
if (is.null(names(ct.cell.size))){
message("Cell size factor vector requires cell type names...")
break
} else {
sum.mat <- ct.cell.size
}
}
basis <- sapply(unique(mean.id[,1]), function(id){
z <- sum.mat[mean.id[,1]]
mean.mat.z <- t(t(mean.mat)*z)
y = as.matrix(mean.mat.z[,mean.id[,1] %in% id])
apply(y,1,mean, na.rm = TRUE)
})
# weighted basis matrix
my.max <- function(x,...){
y <- apply(x,1,max, na.rm = TRUE)
y / median(y, na.rm = T)
}
# MATCH DONOR, CELLTYPE, GENES!!!!!!!!!!!!!!!!
var.adj <- sapply(unique(sample.id), function(sid) {
my.max(sapply(unique(ct.id), function(id) {
y = countmat[, ct.id %in% id & sample.id %in% sid,
drop = FALSE]
apply(y,1,var, na.rm=T)
}), na.rm = T)
})
colnames(var.adj) <- unique(sample.id)
q15 <- apply(var.adj,2,quantile, probs = 0.15, na.rm =T)
# q15 <- apply(var.adj, 2, function(zz){
#   z1 = min(zz[zz>0])
#   z2 = quantile(zz, 0.15, na.rm = T)
#   return(max(z1,z2))
# })
q85 <- apply(var.adj,2,quantile, probs = 0.85, na.rm =T)
var.adj.q <- t(apply(var.adj, 1, function(y){
y[y<q15] <- q15[y<q15]
y[y>q85] <- q85[y>q85]
return(y)}
)
) + 1e-4
message("Creating Basis Matrix adjusted for maximal variance weight")
mean.mat.mvw <- sapply(unique(ct_sample.id), function(id){
sid = unlist(strsplit(id,'%'))[2]
y = as.matrix(countmat[, ct_sample.id %in% id])
yy = sweep(y, 1, sqrt(var.adj.q[,sid]), '/')
apply(yy,1,sum, na.rm = TRUE)/sum(yy)
})
basis.mvw <- sapply(unique(mean.id[,1]), function(id){
z <- sum.mat[mean.id[,1]]
mean.mat.z <- t(t(mean.mat.mvw)*z)
y = as.matrix(mean.mat.z[,mean.id[,1] %in% id])
apply(y,1,mean, na.rm = TRUE)
})
# reorder columns
basis.mvw <- basis.mvw[,ct.sub]
sigma <- sigma[, ct.sub]
basis <- basis[, ct.sub]
sum.mat <- sum.mat[ct.sub]
return(list(basis = basis, sum.mat = sum.mat,
sigma = sigma, basis.mvw = basis.mvw, var.adj.q = var.adj.q))
}
tmouse.subcl <- SCDC_prop_subcl_marker(bulk.eset = bulk10x, sc.eset = tmouse, ct.varname = "md_cluster", fl.varname = "metacluster2", sample = "subj",
ct.sub = c("endothelial","fibroblast","immune","luminal","basal"),
ct.fl.sub = unique(tmouse$metacluster2), select.marker = T, LFC.lim = 5)
tmouse.subcl$prop.est
qc.tmouse<- readRDS("qc_tmouse.rds")
bulk10x <- readRDS("peroubulk10x_fvb34.rds")
tmouse.subcl <- SCDC_prop_subcl_marker(bulk.eset = bulk10x, sc.eset = tmouse, ct.varname = "md_cluster", fl.varname = "metacluster2", sample = "subj",
ct.sub = c("endothelial","fibroblast","immune","luminal","basal"),
ct.fl.sub = unique(tmouse$metacluster2), select.marker = T, LFC.lim = 5)
tmouse.subcl$prop.est
combo[[1]]
combo[[2]]
setwd("C:/Users/meichen/OneDrive - University of North Carolina at Chapel Hill/994/SCDC/package/SCDC2/SCDC")
require(devtools)
use_readme_rmd()
use_vignette("SCDC")
use_github_links()
use_travis()
use_cran_badge()
pkgdown::build_site()
pkgdown::build_site()
pkgdown::build_site()
setwd("C:/Users/meichen/OneDrive - University of North Carolina at Chapel Hill/994/SCDC/package/SCDC2/SCDC") # THE OLD PATH HAS ERROR TO UPDATE TO GITHUB
devtools::document()
setwd("C:/Users/meichen/OneDrive - University of North Carolina at Chapel Hill/994/SCDC/package/SCDC2/SCDC") # THE OLD PATH HAS ERROR TO UPDATE TO GITHUB
devtools::document()
setwd("..")
devtools::install("SCDC")
library(SCDC)
setwd("C:/Users/meichen/OneDrive - University of North Carolina at Chapel Hill/994/SCDC/package/SCDC2/SCDC") # THE OLD PATH HAS ERROR TO UPDATE TO GITHUB
pkgdown::build_site()
use_vignette("C:/Users/meichen/OneDrive - University of North Carolina at Chapel Hill/994/SCDC/package/SCDC2/SCDC/vignettes/SCDC")
pkgdown::build_site()
sceset <- qc.seger$sc.eset.qc
