Skip to content

Commit

Permalink
to work with one sample
Browse files Browse the repository at this point in the history
  • Loading branch information
@ycao6928
ycao6928 committed Oct 29, 2023
1 parent d903462 commit 0478940
Show file tree
Hide file tree
Showing 4 changed files with 56 additions and 37 deletions.
14 changes: 7 additions & 7 deletions R/helper_celltype_expression.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -79,7 +79,7 @@ remove_mito_ribo <- function(alldata) {
#' function only calculates the HVG across all cells and returns a vector of HVGs.
#' @noRd
find_var_gene <- function(alldata, num_top_gene = 1500, ncores = 1, celltype = TRUE) {
BPparam <- generateBPParam(ncores)
BPparam <- scFeatures:::generateBPParam(ncores)

if (celltype == TRUE) {
# here calculates the HVG across all cells across all cell types
Expand All @@ -96,9 +96,9 @@ find_var_gene <- function(alldata, num_top_gene = 1500, ncores = 1, celltype = T


# below calculates the HVG within each cell type
# thiscelltype <- unique( alldata$celltype)[1]
# thiscelltype <- unique( alldata$celltype)[28]
gene <- BiocParallel::bplapply(unique(alldata$celltype), function(thiscelltype) {
this_data <- alldata$data[, alldata$celltype == thiscelltype]
this_data <- alldata$data[, alldata$celltype == thiscelltype, drop=FALSE ]
this_data_sample <- alldata$sample[ alldata$celltype == thiscelltype]
thisgene <- c()

Expand Down Expand Up @@ -171,7 +171,7 @@ find_var_gene <- function(alldata, num_top_gene = 1500, ncores = 1, celltype = T
#' The output is a returns a matrix of samples by features.
#' @noRd
helper_gene_mean_celltype <- function( alldata, genes = NULL, num_top_gene = NULL, ncores = 1) {
BPparam <- generateBPParam(ncores)
BPparam <- scFeatures:::generateBPParam(ncores)


if (is.null(num_top_gene)) {
Expand All @@ -180,7 +180,7 @@ helper_gene_mean_celltype <- function( alldata, genes = NULL, num_top_gene = NUL


if (is.null(genes)) {
all_marker <- find_var_gene(alldata ,
all_marker <- find_var_gene(alldata ,
num_top_gene = num_top_gene,
ncores = ncores, celltype = TRUE
)
Expand Down Expand Up @@ -337,8 +337,8 @@ helper_gene_cor_celltype <- function(alldata, genes = NULL, num_top_gene = NULL,
# thiscelltype <- unique( alldata$celltype) [1]

cor_thiscelltype <- BiocParallel::bplapply(unique(all_marker$celltype), function(thiscelltype) {
thisdata <- alldata$data[, alldata$celltype == thiscelltype]
thisdata_sample <- alldata$sample[alldata$celltype == thiscelltype]
thisdata <- alldata$data[, alldata$celltype == thiscelltype , drop = FALSE ]
thisdata_sample <- alldata$sample[alldata$celltype == thiscelltype ]
gene <- all_marker[all_marker$celltype == thiscelltype, ]$marker
thisdata <- thisdata[gene, ]

Expand Down
8 changes: 4 additions & 4 deletions R/helper_proportion.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -30,7 +30,7 @@ helper_proportion_raw <- function( alldata, logit = TRUE) {
rownames(df) <- df$sample
df <- df[, -1]

df <- df[unique(alldata$sample), ]
df <- df[unique(alldata$sample),]

return(df)
}
Expand All @@ -43,7 +43,7 @@ helper_proportion_raw <- function( alldata, logit = TRUE) {
#' @noRd
helper_proportion_ratio <- function( alldata, ncores = 1) {

BPparam <- generateBPParam(ncores)
BPparam <- scFeatures:::generateBPParam(ncores)

allcelltype <- unique( alldata$celltype)

Expand Down Expand Up @@ -128,10 +128,10 @@ helper_proportion_ratio <- function( alldata, ncores = 1) {
#' @noRd
#'
helper_proportion_raw_st <- function(alldata, logit = TRUE, ncores = 1) {
BPparam <- generateBPParam(ncores)
BPparam <- scFeatures:::generateBPParam(ncores)


num_cell_spot <- get_num_cell_per_celltype(alldata)
num_cell_spot <- scFeatures:::get_num_cell_per_celltype(alldata)

prop_table <- BiocParallel::bplapply(unique(alldata$sample), function(s) {
index <- which(alldata$sample == s)
Expand Down
65 changes: 42 additions & 23 deletions R/helper_spatial_metrics.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -42,7 +42,7 @@ individual_celltype_interaction_sp <- function(this_sample) {
})

nn_list_cellTypes <- unlist(nn_list_cellTypes)
nn_list_cellTypes <- rearrange_string(nn_list_cellTypes)
nn_list_cellTypes <- scFeatures:::rearrange_string(nn_list_cellTypes)
nn_list_cellTypes <- table(nn_list_cellTypes)

return(nn_list_cellTypes)
Expand All @@ -57,7 +57,7 @@ individual_celltype_interaction_sp <- function(this_sample) {
#' @noRd
helper_celltype_interaction_sp <- function( alldata, ncores = 1) {

BPparam <- generateBPParam(ncores)
BPparam <- scFeatures:::generateBPParam(ncores)

# s <- unique( alldata$sample)[1]

Expand Down Expand Up @@ -111,9 +111,10 @@ helper_celltype_interaction_sp <- function( alldata, ncores = 1) {
}



rownames(temp) <- temp$nn_list_cellTypes
temp <- temp[, -1]

temp <- temp[, -1, drop=FALSE]
colnames(temp) <- unique(alldata$sample)

temp <- t(temp)
Expand Down Expand Up @@ -332,10 +333,13 @@ helper_L_stat_st <- function(alldata, ncores = 1) {
colnames(temp) <- make.names(colnames(temp), unique = TRUE)
}


rownames(temp) <- temp$rowname
temp <- temp[, -1]

if (ncol(temp == 2)){
temp <- temp[, -2, drop=FALSE]
}else{
rownames(temp) <- temp$rowname
temp <- temp[, -1]
}

colnames(temp) <- unique(alldata$sample)

temp <- t(temp)
Expand Down Expand Up @@ -373,7 +377,7 @@ individual_L_stat_sp <- function(this_sample) {

L_patient <- list()
for (i in seq_len(nrow(cellTypes_pair))) {
L_patient[[i]] <- L_stats(cell_points,
L_patient[[i]] <- scFeatures:::L_stats(cell_points,
from = cellTypes_pair[i, 1],
to = cellTypes_pair[i, 2],
L_dist = 50
Expand Down Expand Up @@ -442,15 +446,21 @@ helper_L_stat_sp <- function( alldata, ncores = 1) {
}


rownames(temp) <- temp$rowname
temp <- temp[, -1]

if (ncol(temp == 2)){
temp <- temp[, -2, drop=FALSE]
}else{
rownames(temp) <- temp$rowname
temp <- temp[, -1]
}
colnames(temp) <- unique(alldata$sample)

temp <- t(temp)

temp[is.na(temp)] <- 0
L_patient <- temp

colnames(temp) <- unique(alldata$sample)

temp <- t(temp)

temp[is.na(temp)] <- 0
L_patient <- temp

return(L_patient)
}
Expand Down Expand Up @@ -569,9 +579,14 @@ helper_nncorr_protein <- function(alldata, num_top_gene = NULL, ncores = 1) {
}


rownames(temp) <- temp$rowname
temp <- temp[, -1]

if (ncol(temp == 2)){
temp <- temp[, -2, drop=FALSE]
}else{
rownames(temp) <- temp$rowname
temp <- temp[, -1]
}


colnames(temp) <- unique(alldata$sample)

temp <- t(temp)
Expand Down Expand Up @@ -698,10 +713,14 @@ helper_moran <- function( alldata, num_top_gene = NULL, ncores = 1) {
colnames(temp) <- make.names(colnames(temp), unique = TRUE)
}


rownames(temp) <- temp$rowname
temp <- temp[, -1]

if (ncol(temp == 2)){
temp <- temp[, -2, drop=FALSE]
}else{
rownames(temp) <- temp$rowname
temp <- temp[, -1]
}


colnames(temp) <- unique(alldata$sample)

temp <- t(temp)
Expand Down
6 changes: 3 additions & 3 deletions R/run_scfeatures.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -48,9 +48,9 @@ run_proportion_raw <- function(data, type = "scrna", ncores = 1) {
"for feature `proportion_raw`"
)
}
X <- helper_proportion_raw(data, logit = FALSE)
X <- scFeatures:::helper_proportion_raw(data, logit = FALSE)
} else if (type == "spatial_t") {
X <- helper_proportion_raw_st(data, logit = FALSE, ncores)
X <- scFeatures:::helper_proportion_raw_st(data, logit = FALSE, ncores)
} else {
cli::cli_abort(c(
"Parameter {.var type} must be 'scrna', 'spatial_p' or 'spatial_t'",
Expand Down Expand Up @@ -112,7 +112,7 @@ run_proportion_logit <- function(data, type = "scrna", ncores = 1) {
"for feature proportion_logit."
)
}
X <- helper_proportion_raw(data, logit = TRUE)
X <- scFeatures:::helper_proportion_raw(data, logit = TRUE)
} else if (type == "spatial_t") {
X <- helper_proportion_raw_st(data, logit = TRUE, ncores)
} else {
Expand Down

0 comments on commit 0478940

Please sign in to comment.