" + "\n")
for fig in figs:
dashboard.write("
" + "\n")
- inner_html = fig.to_html().split('')[1].split('')[0]
+ inner_html = fig.to_html().split("")[1].split("")[0]
dashboard.write(inner_html)
dashboard.write("
" + "\n")
dashboard.write("
" + "\n")
dashboard.write("" + "\n")
+
#### configurations
# inputs
@@ -61,9 +65,11 @@ def figures_to_html(figs, filename="dashboard.html"):
plot_path = snakemake.output["plot"]
# parameters
-dimensions = int(snakemake.params["n_components"]) #2
-point_size = 2*snakemake.params["size"] if dimensions==3 else 5*snakemake.params["size"] # 2
-point_alpha = snakemake.params["alpha"] #1
+dimensions = int(snakemake.params["n_components"]) # 2
+point_size = (
+ 2 * snakemake.params["size"] if dimensions == 3 else 5 * snakemake.params["size"]
+) # 2
+point_alpha = snakemake.params["alpha"] # 1
width = 750
height = 750
@@ -73,96 +79,103 @@ def figures_to_html(figs, filename="dashboard.html"):
metadata = pd.read_csv(metadata_path, index_col=0)
# fix metadata indices if they do not agree with data as they come from outside the workflow (e.g., R)
-if not(all(data.index==metadata.index)):
- #metadata.index = metadata.index.map(str)
- if metadata.index.inferred_type=='string':
- metadata.index = [idx.replace('-','.') for idx in metadata.index]
+if not (all(data.index == metadata.index)):
+ # metadata.index = metadata.index.map(str)
+ if metadata.index.inferred_type == "string":
+ metadata.index = [idx.replace("-", ".") for idx in metadata.index]
metadata_features = pd.read_csv(metadata_features_path, index_col=0)
-data_all = pd.concat([data.iloc[:,:dimensions], metadata, metadata_features], axis=1)
-data_all = data_all.fillna('')
+data_all = pd.concat([data.iloc[:, :dimensions], metadata, metadata_features], axis=1)
+data_all = data_all.fillna("")
-# sort metadata by data type
+# sort metadata by data type
meta_num = list()
meta_cat = list()
for variable in data_all.columns[dimensions:]:
unique_vals = list(data_all[variable].unique())
- #unique_vals = unique_vals[~np.isnan(unique_vals)] #unique_vals[pd.notna(unique_vals)]
-
+ # unique_vals = unique_vals[~np.isnan(unique_vals)] #unique_vals[pd.notna(unique_vals)]
+
# check if integer AND less than 25 unique values -> categorical metadata
- if all([isinstance(i, (int, np.int64)) for i in unique_vals]) and len(unique_vals)<25:
- #data_all[variable] = data_all[variable].values.astype(str)
+ if (
+ all([isinstance(i, (int, np.int64)) for i in unique_vals])
+ and len(unique_vals) < 25
+ ):
+ # data_all[variable] = data_all[variable].values.astype(str)
meta_cat.append(variable)
continue
-
+
if all([isinstance(i, (str, bool, np.bool_)) for i in unique_vals]):
-# print('discrete variable ', variable)
+ # print('discrete variable ', variable)
meta_cat.append(variable)
-
+
elif all([isinstance(i, (int, float, np.int64)) for i in unique_vals]):
-# print('continous variable ', variable)
+ # print('continous variable ', variable)
meta_num.append(variable)
-
+
else:
print("variable type not-detected for {}".format(variable))
# if clustering results are provided add them as categorical data
-if metadata_clusterings_path!="":
+if metadata_clusterings_path != "":
metadata_clusterings = pd.read_csv(metadata_clusterings_path, index_col=0)
data_all = pd.concat([data_all, metadata_clusterings], axis=1)
meta_cat = meta_cat + metadata_clusterings.columns.tolist()
-
+
# plotting the interactive scatter plot
-#in 2D
-if dimensions==2:
- fig_num = px.scatter(data_all,
- x=data_all.columns[0],
- y=data_all.columns[1],
- hover_data=meta_cat,
- custom_data=list(data_all.columns)[dimensions:],
- width=width,
- height=height,
- opacity=point_alpha,
- title="Numerical Metadata",
- )
- fig_cat = px.scatter(data_all,
- x=data_all.columns[0],
- y=data_all.columns[1],
- hover_data=meta_cat,
- custom_data=list(data_all.columns)[dimensions:],
- width=width,
- height=height,
- opacity=point_alpha,
- title="Categorical Metadata",
- render_mode = "webgl" # required for less than 1000 datapoints, otherwise metadata selection does not work
- )
+# in 2D
+if dimensions == 2:
+ fig_num = px.scatter(
+ data_all,
+ x=data_all.columns[0],
+ y=data_all.columns[1],
+ hover_data=meta_cat,
+ custom_data=list(data_all.columns)[dimensions:],
+ width=width,
+ height=height,
+ opacity=point_alpha,
+ title="Numerical Metadata",
+ )
+ fig_cat = px.scatter(
+ data_all,
+ x=data_all.columns[0],
+ y=data_all.columns[1],
+ hover_data=meta_cat,
+ custom_data=list(data_all.columns)[dimensions:],
+ width=width,
+ height=height,
+ opacity=point_alpha,
+ title="Categorical Metadata",
+ render_mode="webgl", # required for less than 1000 datapoints, otherwise metadata selection does not work
+ )
# in 3D
-elif dimensions==3:
- fig_num = px.scatter_3d(data_all,
- x=data_all.columns[0],
- y=data_all.columns[1],
- z=data_all.columns[2],
- hover_data=meta_cat,
- custom_data=list(data_all.columns)[dimensions:],
- width=width,
- height=height,
- opacity=point_alpha,
- title="Numerical Metadata",
- )
- fig_cat = px.scatter_3d(data_all,
- x=data_all.columns[0],
- y=data_all.columns[1],
- z=data_all.columns[2],
- hover_data=meta_cat,
- custom_data=list(data_all.columns)[dimensions:],
- width=width,
- height=height,
- opacity=point_alpha,
- title="Categorical Metadata",
- )
-
-# set point size
+elif dimensions == 3:
+ fig_num = px.scatter_3d(
+ data_all,
+ x=data_all.columns[0],
+ y=data_all.columns[1],
+ z=data_all.columns[2],
+ hover_data=meta_cat,
+ custom_data=list(data_all.columns)[dimensions:],
+ width=width,
+ height=height,
+ opacity=point_alpha,
+ title="Numerical Metadata",
+ )
+ fig_cat = px.scatter_3d(
+ data_all,
+ x=data_all.columns[0],
+ y=data_all.columns[1],
+ z=data_all.columns[2],
+ hover_data=meta_cat,
+ custom_data=list(data_all.columns)[dimensions:],
+ width=width,
+ height=height,
+ opacity=point_alpha,
+ title="Categorical Metadata",
+ )
+
+# set point size
fig_num.update_traces(marker=dict(size=point_size))
fig_cat.update_traces(marker=dict(size=point_size))
@@ -182,24 +195,28 @@ def figures_to_html(figs, filename="dashboard.html"):
"label": variable,
"method": "update",
"args": [
- {'legendgroup': '',
- 'marker': {'color': data_all[variable].to_numpy(),
- 'coloraxis': 'coloraxis',
- 'symbol': 'circle',
- 'size':point_size},
- 'mode': 'markers',
- 'name': '',
- 'showlegend': False,
- }
+ {
+ "legendgroup": "",
+ "marker": {
+ "color": data_all[variable].to_numpy(),
+ "coloraxis": "coloraxis",
+ "symbol": "circle",
+ "size": point_size,
+ },
+ "mode": "markers",
+ "name": "",
+ "showlegend": False,
+ }
],
- } for variable in meta_num
+ }
+ for variable in meta_num
],
"direction": "down",
"showactive": True,
"x": 1,
"xanchor": "right",
"y": 1,
- "yanchor": "top"
+ "yanchor": "top",
},
],
)
@@ -216,20 +233,24 @@ def figures_to_html(figs, filename="dashboard.html"):
"label": variable,
"method": "update",
"args": [
- {"marker.color": config_button_cat(fig_cat, data_all, variable),
- 'showlegend': False, #[data_all.shape[0]*[True]],
- 'legendgroup': '',#data_all[variable],
- 'name': '',#data_all[variable]
+ {
+ "marker.color": config_button_cat(
+ fig_cat, data_all, variable
+ ),
+ "showlegend": False, # [data_all.shape[0]*[True]],
+ "legendgroup": "", # data_all[variable],
+ "name": "", # data_all[variable]
}
],
- } for variable in meta_cat
+ }
+ for variable in meta_cat
],
"direction": "down",
"showactive": True,
"x": 1,
"xanchor": "right",
"y": 1,
- "yanchor": "top"
+ "yanchor": "top",
},
],
)
diff --git a/workflow/scripts/plot_pca.R b/workflow/scripts/plot_pca.R
index 4c40717..3a6c4cf 100644
--- a/workflow/scripts/plot_pca.R
+++ b/workflow/scripts/plot_pca.R
@@ -20,47 +20,47 @@ pairs_path <- snakemake@output[["pairs_plot"]]
loadingsplot_path <- snakemake@output[["loadings_plot"]]
loadings_lollipop_plot_path <- snakemake@output[["loadings_lollipop_plot"]]
-pairs_size <- snakemake@config[["scatterplot2d"]][["size"]]/10
-pairs_alpha <- snakemake@config[["scatterplot2d"]][["alpha"]]/2
+pairs_size <- snakemake@config[["scatterplot2d"]][["size"]] / 10
+pairs_alpha <- snakemake@config[["scatterplot2d"]][["alpha"]] / 2
metadata_col <- c(snakemake@config[["metadata_of_interest"]])[1]
### load data
-data <- data.frame(fread(file.path(data_path), header=TRUE), row.names=1)
-metadata <- data.frame(fread(file.path(metadata_path), header=TRUE), row.names=1)
+data <- data.frame(fread(file.path(data_path), header = TRUE), row.names = 1)
+metadata <- data.frame(fread(file.path(metadata_path), header = TRUE), row.names = 1)
# make rownames (R) syntactically valid
rownames(data) <- make.names(rownames(data))
rownames(metadata) <- make.names(rownames(metadata))
# prepare metadata
-if(is.null(metadata_col)){
- metadata_col <- colnames(metadata)[1]
+if (is.null(metadata_col)) {
+ metadata_col <- colnames(metadata)[1]
}
# check if metadata column is only NA and switch to the first that is not
-if(all(is.na(metadata[[metadata_col]]))){
- for(col in colnames(metadata)){
- if(all(is.na(metadata[[col]]))){
- next
- }else{
- metadata_col <- col
- break
- }
+if (all(is.na(metadata[[metadata_col]]))) {
+ for (col in colnames(metadata)) {
+ if (all(is.na(metadata[[col]]))) {
+ next
+ } else {
+ metadata_col <- col
+ break
}
+ }
}
# make metadata rownames R "compatible"
-rownames(metadata) <- gsub(pattern= '-' ,replacement = '.', x = rownames(metadata))
+rownames(metadata) <- gsub(pattern = "-", replacement = ".", x = rownames(metadata))
# align rows
-data <- data[rownames(metadata),]
+data <- data[rownames(metadata), ]
-data_axes <- data.frame(fread(file.path(axes_path), header=TRUE), row.names=1)
-data_loadings <- data.frame(fread(file.path(loadings_path), header=TRUE), row.names=1)
+data_axes <- data.frame(fread(file.path(axes_path), header = TRUE), row.names = 1)
+data_loadings <- data.frame(fread(file.path(loadings_path), header = TRUE), row.names = 1)
-data_var <- data.frame(fread(file.path(var_path), header=TRUE), row.names=1)
-colnames(data_var) <- c('var')
-data_var$PC <- as.numeric(rownames(data_var))+1
+data_var <- data.frame(fread(file.path(var_path), header = TRUE), row.names = 1)
+colnames(data_var) <- c("var")
+data_var$PC <- as.numeric(rownames(data_var)) + 1
### variance plot
print("Variance plots")
@@ -75,45 +75,49 @@ width_panel <- n_col * width
height_panel <- 2 * height
# number of top 10% of PCs
-top_n <- ceiling(nrow(data_var)*0.1)
+top_n <- ceiling(nrow(data_var) * 0.1)
# make plots
# options(repr.plot.width=width_panel, repr.plot.height=height_panel)
pca_plots <- list()
-pca_plots[["scree_all"]] <- ggplot(data_var, aes(x=PC,y=var, group=1))+
- geom_point(size=point_size)+
- geom_line(size=line_size)+
- xlab("Principal Component") +
+pca_plots[["scree_all"]] <- ggplot(data_var, aes(x = PC, y = var, group = 1)) +
+ geom_point(size = point_size) +
+ geom_line(size = line_size) +
+ xlab("Principal Component") +
ylab("Variance Explained") +
- ggtitle("Scree Plot of all Principal Components")+
-theme_linedraw()+ theme(plot.title = element_text(size = 10))
-
-pca_plots[["cum_all"]] <- ggplot(data_var, aes(x=PC,y=cumsum(var), group=1))+
- geom_point(size=point_size)+
- geom_line(size=line_size)+
- xlab("Principal Component") +
+ ggtitle("Scree Plot of all Principal Components") +
+ theme_linedraw() +
+ theme(plot.title = element_text(size = 10))
+
+pca_plots[["cum_all"]] <- ggplot(data_var, aes(x = PC, y = cumsum(var), group = 1)) +
+ geom_point(size = point_size) +
+ geom_line(size = line_size) +
+ xlab("Principal Component") +
ylab("Variance Explained") +
- ggtitle("Cumulative Explained Variance of all Principal Components")+
-theme_linedraw()+ theme(plot.title = element_text(size = 10))
-
-pca_plots[["scree_top"]] <- ggplot(data_var[1:top_n,], aes(x=PC,y=var, group=1))+
- geom_point(size=point_size)+
- geom_line(size=line_size)+
- xlab("Principal Component") +
+ ggtitle("Cumulative Explained Variance of all Principal Components") +
+ theme_linedraw() +
+ theme(plot.title = element_text(size = 10))
+
+pca_plots[["scree_top"]] <- ggplot(data_var[1:top_n, ], aes(x = PC, y = var, group = 1)) +
+ geom_point(size = point_size) +
+ geom_line(size = line_size) +
+ xlab("Principal Component") +
ylab("Variance Explained") +
- ggtitle(paste0("Scree Plot of top ", top_n," Principal Components"))+
-theme_linedraw()+ theme(plot.title = element_text(size = 10))
+ ggtitle(paste0("Scree Plot of top ", top_n, " Principal Components")) +
+ theme_linedraw() +
+ theme(plot.title = element_text(size = 10))
-pca_plots[["cum_top"]] <- ggplot(data_var[1:top_n,], aes(x=PC,y=cumsum(var), group=1))+
- geom_point(size=point_size)+
- geom_line(size=line_size)+
- xlab("Principal Component") +
+pca_plots[["cum_top"]] <- ggplot(data_var[1:top_n, ], aes(x = PC, y = cumsum(var), group = 1)) +
+ geom_point(size = point_size) +
+ geom_line(size = line_size) +
+ xlab("Principal Component") +
ylab("Variance Explained") +
- ggtitle(paste0("Cumulative Explained Variance of top ", top_n," Principal Components"))+
-theme_linedraw()+ theme(plot.title = element_text(size = 10))
+ ggtitle(paste0("Cumulative Explained Variance of top ", top_n, " Principal Components")) +
+ theme_linedraw() +
+ theme(plot.title = element_text(size = 10))
pca_plot_panel <- wrap_plots(pca_plots, ncol = n_col)
@@ -122,135 +126,136 @@ pca_plot_panel <- wrap_plots(pca_plots, ncol = n_col)
# pca_plot_panel
ggsave(basename(diagnostics_path),
- plot = pca_plot_panel,
- device = 'png',
- path = dirname(diagnostics_path),
- scale = 1,
- dpi = 300,
- width = width_panel,
- height = height_panel,
- limitsize = FALSE,
- )
+ plot = pca_plot_panel,
+ device = "png",
+ path = dirname(diagnostics_path),
+ scale = 1,
+ dpi = 300,
+ width = width_panel,
+ height = height_panel,
+ limitsize = FALSE,
+)
### pairs plot
print("Pairs plot")
# convert to categorical if less than 25 unique integer values
-if (is.numeric(metadata[[metadata_col]]) & length(unique(metadata[[metadata_col]]))<=25){
- if(all(metadata[[metadata_col]] == round(metadata[[metadata_col]]))){
- metadata[metadata_col] <- as.factor(metadata[[metadata_col]])
- }
+if (is.numeric(metadata[[metadata_col]]) & length(unique(metadata[[metadata_col]])) <= 25) {
+ if (all(metadata[[metadata_col]] == round(metadata[[metadata_col]]))) {
+ metadata[metadata_col] <- as.factor(metadata[[metadata_col]])
+ }
}
# if a metadata class is empty ("") fill with "unknown"
-if (!any(is.na(metadata[[metadata_col]]))){
- if (any(metadata[[metadata_col]]=="")){
- metadata[metadata[[metadata_col]]=="", metadata_col] <- "unknown"
- }
+if (!any(is.na(metadata[[metadata_col]]))) {
+ if (any(metadata[[metadata_col]] == "")) {
+ metadata[metadata[[metadata_col]] == "", metadata_col] <- "unknown"
+ }
}
# remove groups with less than 3 members from metadata and data
# and set legend parameter according to data type
legend <- NULL
-if (!is.numeric(metadata[[metadata_col]])){
-
- keep_groups <- names(table(metadata[[metadata_col]]))[table(metadata[[metadata_col]])>2]
- keep_idx <- metadata[[metadata_col]] %in% keep_groups
- metadata <- metadata[keep_idx,,drop=FALSE]
- data <- data[rownames(metadata),]
-
- # only add legend in case of less than 10 groups within metadata
- if(length(unique(metadata[[metadata_col]]))<11){
- legend <- 1
- }
+if (!is.numeric(metadata[[metadata_col]])) {
+ keep_groups <- names(table(metadata[[metadata_col]]))[table(metadata[[metadata_col]]) > 2]
+ keep_idx <- metadata[[metadata_col]] %in% keep_groups
+ metadata <- metadata[keep_idx, , drop = FALSE]
+ data <- data[rownames(metadata), ]
+
+ # only add legend in case of less than 10 groups within metadata
+ if (length(unique(metadata[[metadata_col]])) < 11) {
+ legend <- 1
+ }
}
# check if one PC is only zeros (yes, that's apparently possible)
-non_zero_cols <- unname(apply(data, 2, function(x) !all(x==0)))
-data <- data[,non_zero_cols]
-data_axes <- data_axes[non_zero_cols,,drop=FALSE]
+non_zero_cols <- unname(apply(data, 2, function(x) !all(x == 0)))
+data <- data[, non_zero_cols]
+data_axes <- data_axes[non_zero_cols, , drop = FALSE]
# make pairs plot
-if(nrow(data)>0){
- # options(repr.plot.width=10, repr.plot.height=10)
- n_dim <- min(10, ncol(data))
-
- pairs_plot <- ggpairs(
- data = data,
- mapping = ggplot2::aes(color = metadata[[metadata_col]]),
- columns = 1:n_dim,
- title = paste0("PCA pairs plot colored by ",metadata_col),
- upper = list(continuous = wrap("density", alpha = 0.5, size=0.25)),
- lower = list(continuous = wrap("points", alpha = pairs_alpha, size = pairs_size)),
- diag = list(continuous = wrap("densityDiag", alpha = 0.5, size=0.25)),
- params = NULL,
- xlab = NULL,
- ylab = NULL,
- axisLabels = c("show", "internal", "none"),
- columnLabels = data_axes[1:n_dim,'label'],
- labeller = "label_value",
- switch = NULL,
- showStrips = NULL,
- legend = legend,
- cardinality_threshold = 15,
- progress = NULL,
- proportions = NULL
- )+
- theme(legend.position = "bottom") +
+if (nrow(data) > 0) {
+ # options(repr.plot.width=10, repr.plot.height=10)
+ n_dim <- min(10, ncol(data))
+
+ pairs_plot <- ggpairs(
+ data = data,
+ mapping = ggplot2::aes(color = metadata[[metadata_col]]),
+ columns = 1:n_dim,
+ title = paste0("PCA pairs plot colored by ", metadata_col),
+ upper = list(continuous = wrap("density", alpha = 0.5, size = 0.25)),
+ lower = list(continuous = wrap("points", alpha = pairs_alpha, size = pairs_size)),
+ diag = list(continuous = wrap("densityDiag", alpha = 0.5, size = 0.25)),
+ params = NULL,
+ xlab = NULL,
+ ylab = NULL,
+ axisLabels = c("show", "internal", "none"),
+ columnLabels = data_axes[1:n_dim, "label"],
+ labeller = "label_value",
+ switch = NULL,
+ showStrips = NULL,
+ legend = legend,
+ cardinality_threshold = 15,
+ progress = NULL,
+ proportions = NULL
+ ) +
+ theme(legend.position = "bottom") +
labs(fill = metadata_col)
- if (is.numeric(metadata[[metadata_col]])){
- pairs_plot <- pairs_plot + scale_color_gradient2(midpoint=0, low="royalblue4", mid="grey80", high="firebrick2", space ="Lab")
- }
-}else{
- pairs_plot <- ggplot() + annotate("text", x = 0.5, y = 0.5, label = "No group with more than 2 members in the data.") + theme_void()
- n_dim <- 5
+ if (is.numeric(metadata[[metadata_col]])) {
+ pairs_plot <- pairs_plot + scale_color_gradient2(midpoint = 0, low = "royalblue4", mid = "grey80", high = "firebrick2", space = "Lab")
+ }
+} else {
+ pairs_plot <- ggplot() +
+ annotate("text", x = 0.5, y = 0.5, label = "No group with more than 2 members in the data.") +
+ theme_void()
+ n_dim <- 5
}
# save pairs plot
ggsave(basename(pairs_path),
- plot = pairs_plot,
- device = 'png',
- path = dirname(pairs_path),
- scale = 1,
- dpi = 300,
- width = n_dim,
- height = n_dim,
- limitsize = FALSE,
- )
+ plot = pairs_plot,
+ device = "png",
+ path = dirname(pairs_path),
+ scale = 1,
+ dpi = 300,
+ width = n_dim,
+ height = n_dim,
+ limitsize = FALSE,
+)
### loadings plot
print("Loadings plot")
# plot specifications
-n_col <- min(5,n_dim)
-height_panel <- ceiling(n_dim/n_col)*4
+n_col <- min(5, n_dim)
+height_panel <- ceiling(n_dim / n_col) * 4
width_panel <- n_col * 4
loading_plots <- list()
-for(i in 1:(n_dim-1)){
- tmp_x <- i
- tmp_y <- i+1
-
- # determine top 10 features per PC combination
- top_features <- rownames(data_loadings)[order(-(data_loadings[paste0("PC_",tmp_x)]^2 + data_loadings[paste0("PC_",tmp_y)]^2))][1:10]
-
- # subset data
- tmp_loadings <- data_loadings[top_features, c(paste0("PC_",tmp_x), paste0("PC_",tmp_y))]
- tmp_loadings$features <- rownames(tmp_loadings)
- text_var <- "features"
-
- # plot data
- loading_plots[[i]] <- ggplot(data=tmp_loadings, aes_string(x=paste0("PC_",tmp_x), y=paste0("PC_",tmp_y), label=text_var))+
- geom_segment(data=tmp_loadings, aes_string(x=0, y=0, xend=paste0("PC_",tmp_x), yend=paste0("PC_",tmp_y)), arrow=arrow(length=unit(0.2,"cm")), alpha=0.75, color="black") +
- geom_label_repel(size = 2)+
- xlab(paste0("Principal Component ",tmp_x)) +
- ylab(paste0("Principal Component ",tmp_y)) +
+for (i in 1:(n_dim - 1)) {
+ tmp_x <- i
+ tmp_y <- i + 1
+
+ # determine top 10 features per PC combination
+ top_features <- rownames(data_loadings)[order(-(data_loadings[paste0("PC_", tmp_x)]^2 + data_loadings[paste0("PC_", tmp_y)]^2))][1:10]
+
+ # subset data
+ tmp_loadings <- data_loadings[top_features, c(paste0("PC_", tmp_x), paste0("PC_", tmp_y))]
+ tmp_loadings$features <- rownames(tmp_loadings)
+ text_var <- "features"
+
+ # plot data
+ loading_plots[[i]] <- ggplot(data = tmp_loadings, aes_string(x = paste0("PC_", tmp_x), y = paste0("PC_", tmp_y), label = text_var)) +
+ geom_segment(data = tmp_loadings, aes_string(x = 0, y = 0, xend = paste0("PC_", tmp_x), yend = paste0("PC_", tmp_y)), arrow = arrow(length = unit(0.2, "cm")), alpha = 0.75, color = "black") +
+ geom_label_repel(size = 2) +
+ xlab(paste0("Principal Component ", tmp_x)) +
+ ylab(paste0("Principal Component ", tmp_y)) +
theme_linedraw()
-
-# print(tmp_plot)
+
+ # print(tmp_plot)
}
loadings_plot_panel <- wrap_plots(loading_plots, ncol = n_col)
@@ -260,61 +265,58 @@ loadings_plot_panel <- wrap_plots(loading_plots, ncol = n_col)
# loadings_plot_panel
ggsave(basename(loadingsplot_path),
- plot = loadings_plot_panel,
- device = 'png',
- path = dirname(loadingsplot_path),
- scale = 1,
- dpi = 300,
- width = width_panel,
- height = height_panel,
- limitsize = FALSE,
- )
+ plot = loadings_plot_panel,
+ device = "png",
+ path = dirname(loadingsplot_path),
+ scale = 1,
+ dpi = 300,
+ width = width_panel,
+ height = height_panel,
+ limitsize = FALSE,
+)
### loadings lollipop plot
print("Loadings Lollipop plot")
-
+
# plot specifications
-n_col <- min(5,n_dim)
-height_panel <- ceiling(n_dim/n_col)*2
+n_col <- min(5, n_dim)
+height_panel <- ceiling(n_dim / n_col) * 2
width_panel <- n_col * 3
-
+
lollipops <- list()
for (i in 1:n_dim) {
-
- # determine top 10 features per PC
-# top_features <- rownames(data_loadings)[order(-(data_loadings[paste0("PC_",i)]^2))][1:10]
- top_features <- rownames(data_loadings)[order(-abs(data_loadings[paste0("PC_", i)]))][1:10]
-
- # subset data
- tmp_loadings <- data_loadings[top_features, paste0("PC_",i), drop=FALSE]
- colnames(tmp_loadings) <- c("Loadings")
- tmp_loadings$Features <- factor(rownames(tmp_loadings), levels=rev(rownames(tmp_loadings)))
-
- # make plot
- lollipops[[i]] <- ggplot(tmp_loadings, aes(x=Loadings, y=Features)) +
- geom_point(color="blue") +
- geom_segment(aes(xend=0, yend=Features), color="black") +
+ # determine top 10 features per PC
+ # top_features <- rownames(data_loadings)[order(-(data_loadings[paste0("PC_",i)]^2))][1:10]
+ top_features <- rownames(data_loadings)[order(-abs(data_loadings[paste0("PC_", i)]))][1:10]
+
+ # subset data
+ tmp_loadings <- data_loadings[top_features, paste0("PC_", i), drop = FALSE]
+ colnames(tmp_loadings) <- c("Loadings")
+ tmp_loadings$Features <- factor(rownames(tmp_loadings), levels = rev(rownames(tmp_loadings)))
+
+ # make plot
+ lollipops[[i]] <- ggplot(tmp_loadings, aes(x = Loadings, y = Features)) +
+ geom_point(color = "blue") +
+ geom_segment(aes(xend = 0, yend = Features), color = "black") +
theme_bw() +
theme(plot.title = element_text(size = 10)) +
- labs(title=paste("Principal Component ", i), x="Loading", y="Feature")
+ labs(title = paste("Principal Component ", i), x = "Loading", y = "Feature")
}
-lollipop_plot_panel <- wrap_plots(lollipops, ncol=n_col)
+lollipop_plot_panel <- wrap_plots(lollipops, ncol = n_col)
# save diangostics plot
# options(repr.plot.width=width_panel, repr.plot.height=height_panel)
# lollipop_plot_panel
ggsave(basename(loadings_lollipop_plot_path),
- plot = lollipop_plot_panel,
- device = 'png',
- path = dirname(loadings_lollipop_plot_path),
- scale = 1,
- dpi = 300,
- width = width_panel,
- height = height_panel,
- limitsize = FALSE,
- )
-
-
+ plot = lollipop_plot_panel,
+ device = "png",
+ path = dirname(loadings_lollipop_plot_path),
+ scale = 1,
+ dpi = 300,
+ width = width_panel,
+ height = height_panel,
+ limitsize = FALSE,
+)
diff --git a/workflow/scripts/plot_umap_connectivity.py b/workflow/scripts/plot_umap_connectivity.py
index 3d9da01..52f3445 100644
--- a/workflow/scripts/plot_umap_connectivity.py
+++ b/workflow/scripts/plot_umap_connectivity.py
@@ -2,10 +2,8 @@
#### libraries
# general
-import os
import pickle
-import pandas as pd
-import matplotlib.pyplot as plt
+
# dimensionality reduction
import umap
import umap.plot
@@ -19,10 +17,12 @@
plot_connectivity_path = snakemake.output["connectivity_plot"]
### load data
-with open(object_path, 'rb') as f:
+with open(object_path, "rb") as f:
umap_obj = pickle.load(f)
-
+
### generate & save UMAP connectivity plot
# umap.plot.connectivity(umap_obj, show_points=True)
-umap.plot.connectivity(umap_obj, edge_bundling='hammer').figure.savefig(plot_connectivity_path)
+umap.plot.connectivity(umap_obj, edge_bundling="hammer").figure.savefig(
+ plot_connectivity_path
+)
diff --git a/workflow/scripts/plot_umap_diagnostics.py b/workflow/scripts/plot_umap_diagnostics.py
index 552a8de..225afba 100644
--- a/workflow/scripts/plot_umap_diagnostics.py
+++ b/workflow/scripts/plot_umap_diagnostics.py
@@ -2,10 +2,8 @@
#### libraries
# general
-import os
import pickle
-import pandas as pd
-import matplotlib.pyplot as plt
+
# dimensionality reduction
import umap
import umap.plot
@@ -19,14 +17,19 @@
plot_diagnostics_path = snakemake.output["diagnostics_plot"]
### load data
-with open(object_path, 'rb') as f:
+with open(object_path, "rb") as f:
umap_obj = pickle.load(f)
-
+
### generate & save UMAP specific diagnostic plots
-fig_diag, ax_diag = umap.plot.plt.subplots(2, 2, figsize=(12,12))
-umap.plot.diagnostic(umap_obj, diagnostic_type='pca', ax=ax_diag[0,0])
-umap.plot.diagnostic(umap_obj, diagnostic_type='vq', ax=ax_diag[0,1])
-umap.plot.diagnostic(umap_obj, diagnostic_type='local_dim', ax=ax_diag[1,0])
-umap.plot.diagnostic(umap_obj, diagnostic_type='neighborhood', nhood_size=min(umap_obj.n_neighbors, 15), ax=ax_diag[1,1])
+fig_diag, ax_diag = umap.plot.plt.subplots(2, 2, figsize=(12, 12))
+umap.plot.diagnostic(umap_obj, diagnostic_type="pca", ax=ax_diag[0, 0])
+umap.plot.diagnostic(umap_obj, diagnostic_type="vq", ax=ax_diag[0, 1])
+umap.plot.diagnostic(umap_obj, diagnostic_type="local_dim", ax=ax_diag[1, 0])
+umap.plot.diagnostic(
+ umap_obj,
+ diagnostic_type="neighborhood",
+ nhood_size=min(umap_obj.n_neighbors, 15),
+ ax=ax_diag[1, 1],
+)
fig_diag.savefig(plot_diagnostics_path)
diff --git a/workflow/scripts/subset_data.py b/workflow/scripts/subset_data.py
index 05fa4eb..6a8d48a 100644
--- a/workflow/scripts/subset_data.py
+++ b/workflow/scripts/subset_data.py
@@ -2,7 +2,6 @@
#### libraries
# general
-import os
import pandas as pd
#### configurations
@@ -13,7 +12,7 @@
metadata_features_path = snakemake.output["metadata_features"]
# parameters
-samples_by_features = int(snakemake.params['samples_by_features'])
+samples_by_features = int(snakemake.params["samples_by_features"])
features_to_plot = set(snakemake.params["features_to_plot"])
### load data
@@ -23,7 +22,7 @@
data = pd.read_csv(data_path, index_col=0)
else:
data = pd.read_csv(data_path, index_col=0).T
-
+
### check if "ALL" features should be plotted and overlap with columns & subset data
if features_to_plot == {"ALL"}:
features_to_plot = list(data.columns)
@@ -31,11 +30,13 @@
features_to_plot = list(features_to_plot.intersection(set(data.columns)))
# subset data
-if len(features_to_plot)!=0:
- data = data.loc[:,features_to_plot]
+if len(features_to_plot) != 0:
+ data = data.loc[:, features_to_plot]
else:
- print("requested features to plot are not in the provided data, first 10 features will be plotted instead")
- data = data.iloc[:,:10]
+ print(
+ "requested features to plot are not in the provided data, first 10 features will be plotted instead"
+ )
+ data = data.iloc[:, :10]
# save data
-data.to_csv(metadata_features_path)
\ No newline at end of file
+data.to_csv(metadata_features_path)
diff --git a/workflow/scripts/umap_embed.py b/workflow/scripts/umap_embed.py
index f1754a7..d46f96b 100644
--- a/workflow/scripts/umap_embed.py
+++ b/workflow/scripts/umap_embed.py
@@ -5,28 +5,39 @@
import os
import pickle
import pandas as pd
+
# dimensionality reduction
import umap
#### configurations
# ipnuts
-data_path = snakemake.input[0] #"/nobackup/lab_bock/projects/macroIC/results/AKsmall/KOcall_NonTargeting/counts/CORRECTED_RNA.csv"
-graph_object_path = snakemake.input[1] #snakemake.input["knn_object"] #"/nobackup/lab_bock/projects/macroIC/results/AKsmall/unsupervised_analysis/AKsmall_KOcall_NonTargeting_CORRECTED/UMAP_correlation_100_graph.pickle"
+data_path = snakemake.input[
+ 0 # "/nobackup/lab_bock/projects/macroIC/results/AKsmall/KOcall_NonTargeting/counts/CORRECTED_RNA.csv"
+]
+graph_object_path = snakemake.input[
+ 1 # snakemake.input["knn_object"] #"/nobackup/lab_bock/projects/macroIC/results/AKsmall/unsupervised_analysis/AKsmall_KOcall_NonTargeting_CORRECTED/UMAP_correlation_100_graph.pickle"
+]
# outputs
-result_object_path = snakemake.output["result_object"] #"/nobackup/lab_bock/projects/macroIC/results/AKsmall/unsupervised_analysis/AKsmall_KOcall_NonTargeting_CORRECTED/UMAP_correlation_100_0.1_2_object.pickle"
-result_data_path = snakemake.output["result_data"] #"/nobackup/lab_bock/projects/macroIC/results/AKsmall/unsupervised_analysis/AKsmall_KOcall_NonTargeting_CORRECTED/UMAP_correlation_100_0.1_2_data.csv"
-result_axes_path = snakemake.output["result_axes"] #"/nobackup/lab_bock/projects/macroIC/results/AKsmall/unsupervised_analysis/AKsmall_KOcall_NonTargeting_CORRECTED/UMAP_correlation_100_0.1_2_axes.csv"
+result_object_path = snakemake.output[
+ "result_object" # "/nobackup/lab_bock/projects/macroIC/results/AKsmall/unsupervised_analysis/AKsmall_KOcall_NonTargeting_CORRECTED/UMAP_correlation_100_0.1_2_object.pickle"
+]
+result_data_path = snakemake.output[
+ "result_data" # "/nobackup/lab_bock/projects/macroIC/results/AKsmall/unsupervised_analysis/AKsmall_KOcall_NonTargeting_CORRECTED/UMAP_correlation_100_0.1_2_data.csv"
+]
+result_axes_path = snakemake.output[
+ "result_axes" # "/nobackup/lab_bock/projects/macroIC/results/AKsmall/unsupervised_analysis/AKsmall_KOcall_NonTargeting_CORRECTED/UMAP_correlation_100_0.1_2_axes.csv"
+]
result_dir = os.path.dirname(result_object_path)
# parameters
-samples_by_features = int(snakemake.params['samples_by_features']) #0
-metric = snakemake.params['metric'] #"correlation"
-n_neighbors = int(snakemake.params['n_neighbors']) #100
-min_dist = float(snakemake.params['min_dist']) #0.1
-n_components = int(snakemake.params['n_components']) #2
-densmap = True if int(snakemake.params['densmap'])==1 else False #False
+samples_by_features = int(snakemake.params["samples_by_features"]) # 0
+metric = snakemake.params["metric"] # "correlation"
+n_neighbors = int(snakemake.params["n_neighbors"]) # 100
+min_dist = float(snakemake.params["min_dist"]) # 0.1
+n_components = int(snakemake.params["n_components"]) # 2
+densmap = True if int(snakemake.params["densmap"]) == 1 else False # False
# make directory if not existing
if not os.path.exists(result_dir):
@@ -41,80 +52,83 @@
data = pd.read_csv(data_path, index_col=0).T
# if less than 11 datapoints there is no pre-computed KNN graph
-if data.shape[0]<11:
+if data.shape[0] < 11:
print("no pre-computed KNN graph will be used")
knn = (None, None, None)
else:
# load pre-computed KNN graph
- with open(graph_object_path, 'rb') as f:
+ with open(graph_object_path, "rb") as f:
# The protocol version used is detected automatically, so we do not
# have to specify it.
knn = pickle.load(f)
### embed data in low dimensions
-umap_obj=umap.umap_.UMAP(n_neighbors=n_neighbors,
- n_components=n_components,
- metric=metric,
- metric_kwds=None,
- output_metric='euclidean',
- output_metric_kwds=None,
- n_epochs=None,
- learning_rate=1.0,
- init='spectral',
- min_dist=min_dist,
- spread=1.0,
- low_memory=True,
- n_jobs=-1,
- set_op_mix_ratio=1.0,
- local_connectivity=1.0,
- repulsion_strength=1.0,
- negative_sample_rate=5,
- transform_queue_size=4.0,
- a=None,
- b=None,
- random_state=42,
- angular_rp_forest=False,
- target_n_neighbors=-1,
- target_metric='categorical',
- target_metric_kwds=None,
- target_weight=0.5,
- transform_seed=42,
- transform_mode='embedding',
- force_approximation_algorithm=False,
- verbose=False,
- tqdm_kwds=None,
- unique=False,
- densmap=densmap,
- dens_lambda=2.0,
- dens_frac=0.3,
- dens_var_shift=0.1,
- output_dens=False,
- disconnection_distance=None,
- precomputed_knn=knn
- ).fit(data)
+umap_obj = umap.umap_.UMAP(
+ n_neighbors=n_neighbors,
+ n_components=n_components,
+ metric=metric,
+ metric_kwds=None,
+ output_metric="euclidean",
+ output_metric_kwds=None,
+ n_epochs=None,
+ learning_rate=1.0,
+ init="spectral",
+ min_dist=min_dist,
+ spread=1.0,
+ low_memory=True,
+ n_jobs=-1,
+ set_op_mix_ratio=1.0,
+ local_connectivity=1.0,
+ repulsion_strength=1.0,
+ negative_sample_rate=5,
+ transform_queue_size=4.0,
+ a=None,
+ b=None,
+ random_state=42,
+ angular_rp_forest=False,
+ target_n_neighbors=-1,
+ target_metric="categorical",
+ target_metric_kwds=None,
+ target_weight=0.5,
+ transform_seed=42,
+ transform_mode="embedding",
+ force_approximation_algorithm=False,
+ verbose=False,
+ tqdm_kwds=None,
+ unique=False,
+ densmap=densmap,
+ dens_lambda=2.0,
+ dens_frac=0.3,
+ dens_var_shift=0.1,
+ output_dens=False,
+ disconnection_distance=None,
+ precomputed_knn=knn,
+).fit(data)
# data_embedding = umap_obj.fit_transform(data)
-data_df = pd.DataFrame(umap_obj.embedding_, index=data.index,)
+data_df = pd.DataFrame(
+ umap_obj.embedding_,
+ index=data.index,
+)
data_df = data_df.rename_axis(("sample_name"))
if densmap:
- data_df.columns = ["densMAP_{}".format(str(idx+1)) for idx in data_df.columns]
+ data_df.columns = ["densMAP_{}".format(str(idx + 1)) for idx in data_df.columns]
else:
- data_df.columns = ["UMAP_{}".format(str(idx+1)) for idx in data_df.columns]
+ data_df.columns = ["UMAP_{}".format(str(idx + 1)) for idx in data_df.columns]
### save data
# save umap object
-with open(result_object_path, 'wb') as f:
+with open(result_object_path, "wb") as f:
pickle.dump(umap_obj, f, pickle.HIGHEST_PROTOCOL)
-
+
# save transformed data
data_df.to_csv(result_data_path)
# save axes information for visualization
axes_info_df = pd.DataFrame(data_df.columns)
-axes_info_df.columns = ['label']
-axes_info_df['label'] = [label.replace("_", "")for label in axes_info_df['label']]
+axes_info_df.columns = ["label"]
+axes_info_df["label"] = [label.replace("_", "") for label in axes_info_df["label"]]
axes_info_df.to_csv(result_axes_path)
-
diff --git a/workflow/scripts/umap_graph.py b/workflow/scripts/umap_graph.py
index a58ea70..aaa58af 100644
--- a/workflow/scripts/umap_graph.py
+++ b/workflow/scripts/umap_graph.py
@@ -5,23 +5,27 @@
import os
import pickle
import pandas as pd
+
# dimensionality reduction
-import umap
from umap.umap_ import nearest_neighbors
#### configurations
# ipnuts
-data_path = snakemake.input["data"] #"/nobackup/lab_bock/projects/macroIC/results/CC001/counts/mdm_normCQN.csv"
+data_path = snakemake.input[
+ "data" # "/nobackup/lab_bock/projects/macroIC/results/CC001/counts/mdm_normCQN.csv"
+]
# outputs
-result_object_path = snakemake.output["result_object"] # "/nobackup/lab_bock/projects/macroIC/results/CC001/unsupervised_analysis/mdm_normCQN/UMAP/UMAP_correlation_5_0.1_2_object.pickle"
+result_object_path = snakemake.output[
+ "result_object" # "/nobackup/lab_bock/projects/macroIC/results/CC001/unsupervised_analysis/mdm_normCQN/UMAP/UMAP_correlation_5_0.1_2_object.pickle"
+]
result_dir = os.path.dirname(result_object_path)
# parameters
-samples_by_features = int(snakemake.params['samples_by_features']) #0
-metric = snakemake.params['metric'] # "correlation"
-n_neighbors = int(snakemake.params['n_neighbors']) #100
+samples_by_features = int(snakemake.params["samples_by_features"]) # 0
+metric = snakemake.params["metric"] # "correlation"
+n_neighbors = int(snakemake.params["n_neighbors"]) # 100
# make directory if not existing
if not os.path.exists(result_dir):
@@ -36,25 +40,28 @@
data = pd.read_csv(data_path, index_col=0).T
# if less than 11 datapoints the KNN graph object can not be serialized (PyNNdescent issue: https://github.com/Teichlab/bbknn/issues/48)
-if data.shape[0]<11:
+if data.shape[0] < 11:
from pathlib import Path
+
Path(result_object_path).touch()
import sys
+
sys.exit()
-
+
### get knn-graph
-knn = nearest_neighbors(data,
- n_neighbors=n_neighbors,
- metric=metric,
- metric_kwds=None,
- angular=False,
- random_state=42,
- low_memory=True,
- use_pynndescent=True,
- n_jobs=-1,
- verbose=False
- )
+knn = nearest_neighbors(
+ data,
+ n_neighbors=n_neighbors,
+ metric=metric,
+ metric_kwds=None,
+ angular=False,
+ random_state=42,
+ low_memory=True,
+ use_pynndescent=True,
+ n_jobs=-1,
+ verbose=False,
+)
## save knn graph object
-with open(result_object_path, 'wb') as f:
- pickle.dump(knn, f, pickle.HIGHEST_PROTOCOL)
\ No newline at end of file
+with open(result_object_path, "wb") as f:
+ pickle.dump(knn, f, pickle.HIGHEST_PROTOCOL)
diff --git a/workflow/scripts/validation_external.py b/workflow/scripts/validation_external.py
index ca3b7dd..a1f620b 100644
--- a/workflow/scripts/validation_external.py
+++ b/workflow/scripts/validation_external.py
@@ -17,36 +17,41 @@
# load the clustering results and categorical metadata
metadata = pd.read_csv(metadata_path, index_col=0)
-metadata = metadata.fillna('')
+metadata = metadata.fillna("")
clustering_results = pd.read_csv(clusterings_path, index_col=0)
-indices = [s.split('external_index_')[1].split('.csv')[0] for s in result_paths]
+indices = [s.split("external_index_")[1].split(".csv")[0] for s in result_paths]
# identify categorical metadata
meta_cat = []
for variable in metadata.columns:
unique_vals = list(metadata[variable].unique())
-
+
# check if integer AND less than 25 unique values -> categorical metadata
- if all([isinstance(i, (int, np.int64)) for i in unique_vals]) and len(unique_vals)<25:
+ if (
+ all([isinstance(i, (int, np.int64)) for i in unique_vals])
+ and len(unique_vals) < 25
+ ):
meta_cat.append(variable)
continue
-
+
if all([isinstance(i, (str, bool, np.bool_)) for i in unique_vals]):
meta_cat.append(variable)
-
+
else:
print("variable {} not categorical".format(variable))
# subset for categorical data
-categorical_metadata = metadata.loc[:,meta_cat]
+categorical_metadata = metadata.loc[:, meta_cat]
# Ensure that the clustering results and categorical metadata have the same indices
# fix metadata indices if they do not agree with data as they come from outside the workflow (e.g., R)
-if not(set(clustering_results.index) == set(categorical_metadata.index)):
- if categorical_metadata.index.inferred_type=='string':
- categorical_metadata.index = [idx.replace('-','.') for idx in categorical_metadata.index]
+if not (set(clustering_results.index) == set(categorical_metadata.index)):
+ if categorical_metadata.index.inferred_type == "string":
+ categorical_metadata.index = [
+ idx.replace("-", ".") for idx in categorical_metadata.index
+ ]
# Reorder the rows of the clustering results DataFrame
clustering_results = clustering_results.reindex(categorical_metadata.index)
@@ -55,23 +60,35 @@
# Create a DataFrame for each index
for idx in indices:
- idx_dfs[idx] = pd.DataFrame(index=clustering_results.columns, columns=categorical_metadata.columns)
-
+ idx_dfs[idx] = pd.DataFrame(
+ index=clustering_results.columns, columns=categorical_metadata.columns
+ )
+
# For each clustering result
for clustering in clustering_results.columns:
# For each categorical metadata
for metadata in categorical_metadata.columns:
# Calculate & store the scores
- idx_dfs["AMI"].loc[clustering, metadata] = metrics.adjusted_mutual_info_score(categorical_metadata[metadata], clustering_results[clustering])
- idx_dfs["ARI"].loc[clustering, metadata] = metrics.adjusted_rand_score(categorical_metadata[metadata], clustering_results[clustering])
- idx_dfs["FMI"].loc[clustering, metadata] = metrics.fowlkes_mallows_score(categorical_metadata[metadata], clustering_results[clustering])
-
- homogeneity, completeness, v_measure = metrics.homogeneity_completeness_v_measure(categorical_metadata[metadata], clustering_results[clustering])
+ idx_dfs["AMI"].loc[clustering, metadata] = metrics.adjusted_mutual_info_score(
+ categorical_metadata[metadata], clustering_results[clustering]
+ )
+ idx_dfs["ARI"].loc[clustering, metadata] = metrics.adjusted_rand_score(
+ categorical_metadata[metadata], clustering_results[clustering]
+ )
+ idx_dfs["FMI"].loc[clustering, metadata] = metrics.fowlkes_mallows_score(
+ categorical_metadata[metadata], clustering_results[clustering]
+ )
+
+ homogeneity, completeness, v_measure = (
+ metrics.homogeneity_completeness_v_measure(
+ categorical_metadata[metadata], clustering_results[clustering]
+ )
+ )
idx_dfs["Homogeneity"].loc[clustering, metadata] = homogeneity
idx_dfs["Completeness"].loc[clustering, metadata] = completeness
idx_dfs["V"].loc[clustering, metadata] = v_measure
-
+
# # Save the DataFrames as CSV files
for i, idx in enumerate(indices):
idx_dfs[idx].to_csv(result_paths[i])
diff --git a/workflow/scripts/validation_internal.R b/workflow/scripts/validation_internal.R
index a91a57e..798f0a3 100644
--- a/workflow/scripts/validation_internal.R
+++ b/workflow/scripts/validation_internal.R
@@ -8,14 +8,14 @@ set.seed(42)
# helper function for BIC calculation
do_BIC <- function(x) {
- # Check if there are at least two unique values in the column
- if(length(unique(x)) < 2){
- # Return Inf if there's only one unique value
- return(Inf)
- } else {
- # Perform BIC calculation if there are two or more unique values
- return(BIC(lm(data_mtx[,i] ~ as.factor(x))))
- }
+ # Check if there are at least two unique values in the column
+ if (length(unique(x)) < 2) {
+ # Return Inf if there's only one unique value
+ return(Inf)
+ } else {
+ # Perform BIC calculation if there are two or more unique values
+ return(BIC(lm(data_mtx[, i] ~ as.factor(x))))
+ }
}
### configurations
@@ -30,15 +30,15 @@ pca_var_path <- snakemake@input[["pca_var"]]
result_path <- snakemake@output[["internal_indices"]]
# parameters
-internal_index <- as.character(snakemake@params['internal_index']) #"Silhouette"
-sample_proportion <- as.numeric(snakemake@params['sample_proportion']) #0.1
-metadata_of_interest <- unlist(c(snakemake@params['metadata_of_interest']))
+internal_index <- as.character(snakemake@params["internal_index"]) # "Silhouette"
+sample_proportion <- as.numeric(snakemake@params["sample_proportion"]) # 0.1
+metadata_of_interest <- unlist(c(snakemake@params["metadata_of_interest"]))
### load data
-metadata <- data.frame(fread(file.path(metadata_path), header=TRUE), row.names=1)
-clusterings <- data.frame(fread(file.path(clusterings_path), header=TRUE), row.names=1)
-pca_var <- data.frame(fread(file.path(pca_var_path), header=TRUE), row.names=1)
-pca <- data.frame(fread(file.path(pca_path), header=TRUE), row.names=1)
+metadata <- data.frame(fread(file.path(metadata_path), header = TRUE), row.names = 1)
+clusterings <- data.frame(fread(file.path(clusterings_path), header = TRUE), row.names = 1)
+pca_var <- data.frame(fread(file.path(pca_var_path), header = TRUE), row.names = 1)
+pca <- data.frame(fread(file.path(pca_path), header = TRUE), row.names = 1)
### USED BEFORE when PCA was not configurable
# # load PCs that explain >90% of the variance in the data
@@ -53,37 +53,37 @@ pca <- data.frame(fread(file.path(pca_path), header=TRUE), row.names=1)
# pca <- data.frame(fread(file.path(pca_path), colClasses = classes, header=TRUE), row.names=1)
# subset metadata to metadata_of_interest
-if(length(metadata_of_interest)==0){
- metadata <- metadata[,1,drop=FALSE]
-}else{
- metadata <- metadata[,metadata_of_interest,drop=FALSE]
+if (length(metadata_of_interest) == 0) {
+ metadata <- metadata[, 1, drop = FALSE]
+} else {
+ metadata <- metadata[, metadata_of_interest, drop = FALSE]
}
# transform metadata
na_cols <- c()
-for (col in colnames(metadata)){
- # if NA or less than 2 unique values -> remove column and move on
- if (any(is.na(metadata[[col]])) | length(unique(metadata[[col]]))<2){
- na_cols <- c(na_cols, col)
- next
- }
- # if a metadata class is empty ("") fill with "unknown"
- if (!any(is.na(metadata[[col]]))){
- if (any(metadata[[col]]=="")){
- metadata[metadata[[col]]=="", col] <- "unknown"
- }
+for (col in colnames(metadata)) {
+ # if NA or less than 2 unique values -> remove column and move on
+ if (any(is.na(metadata[[col]])) | length(unique(metadata[[col]])) < 2) {
+ na_cols <- c(na_cols, col)
+ next
+ }
+ # if a metadata class is empty ("") fill with "unknown"
+ if (!any(is.na(metadata[[col]]))) {
+ if (any(metadata[[col]] == "")) {
+ metadata[metadata[[col]] == "", col] <- "unknown"
}
- # convert metadata to categorical if less than 25 unique integer values
- if (is.numeric(metadata[[col]]) & length(unique(metadata[[col]]))<=25){
- if(all(metadata[[col]] == round(metadata[[col]]))){
- metadata[col] <- as.factor(metadata[[col]])
- }
+ }
+ # convert metadata to categorical if less than 25 unique integer values
+ if (is.numeric(metadata[[col]]) & length(unique(metadata[[col]])) <= 25) {
+ if (all(metadata[[col]] == round(metadata[[col]]))) {
+ metadata[col] <- as.factor(metadata[[col]])
}
+ }
}
# remove columns with NA
-metadata <- metadata[, !(colnames(metadata) %in% na_cols),drop=FALSE]
+metadata <- metadata[, !(colnames(metadata) %in% na_cols), drop = FALSE]
# add categorical metadata to clustering results with prefix "metadata_"
-metadata_cat <- metadata[,sapply(metadata, function(x) !is.numeric(x)), drop=FALSE]
+metadata_cat <- metadata[, sapply(metadata, function(x) !is.numeric(x)), drop = FALSE]
# Convert all categorical columns to integer
metadata_cat[colnames(metadata_cat)] <- lapply(metadata_cat[colnames(metadata_cat)], function(x) as.integer(factor(x)))
colnames(metadata_cat) <- paste0("metadata_", colnames(metadata_cat))
@@ -97,32 +97,32 @@ indices_df <- data.frame(matrix(ncol = 1, nrow = ncol(clusterings), dimnames = l
clusterings[colnames(clusterings)] <- lapply(clusterings[colnames(clusterings)], function(x) as.integer(x))
data_mtx <- as.matrix(pca)
data_mtx <- data_mtx[sample(nrow(data_mtx), ceiling(sample_proportion * nrow(data_mtx))), ]
-clusterings <- clusterings[rownames(data_mtx),,drop=FALSE]
+clusterings <- clusterings[rownames(data_mtx), , drop = FALSE]
# calculate internal cluster index
-if(internal_index %in% c("Silhouette", "Calinski_Harabasz", "C_index", "Davies_Bouldin", "Dunn")){
- for(clust in colnames(clusterings)){
- indices_df[clust,internal_index] <- intCriteria(traj=data_mtx, part=clusterings[[clust]], crit=c(internal_index))
- }
-} else if(internal_index=="AIC"){ # -> NOT USED
- ### determine indices using AIC on top PC of PCA
- AIC_sum <- rep(0L, ncol(clusterings))
-
- for(i in 1:ncol(data_mtx)){
- AIC_sum <- AIC_sum + unlist(apply(clusterings,2,function(x) AIC(lm(data_mtx[,i]~as.factor(x)))))*pca_var[i,1]
- }
- indices_df$AIC <- AIC_sum
-} else if(internal_index=="BIC"){
- ### determine indices using BIC on top PC of PCA
- BIC_sum <- rep(0L, ncol(clusterings))
-
- for(i in 1:ncol(pca)){
-# BIC_sum <- BIC_sum + unlist(apply(clusterings,2,function(x) BIC(lm(data_mtx[,i]~as.factor(x)))))*pca_var[i,1] # crashed in case of only 1 cluster
- BIC_sum <- BIC_sum + unlist(apply(clusterings, 2, do_BIC)) * pca_var[i, 1]
- }
- indices_df$BIC <- BIC_sum
+if (internal_index %in% c("Silhouette", "Calinski_Harabasz", "C_index", "Davies_Bouldin", "Dunn")) {
+ for (clust in colnames(clusterings)) {
+ indices_df[clust, internal_index] <- intCriteria(traj = data_mtx, part = clusterings[[clust]], crit = c(internal_index))
+ }
+} else if (internal_index == "AIC") { # -> NOT USED
+ ### determine indices using AIC on top PC of PCA
+ AIC_sum <- rep(0L, ncol(clusterings))
+
+ for (i in 1:ncol(data_mtx)) {
+ AIC_sum <- AIC_sum + unlist(apply(clusterings, 2, function(x) AIC(lm(data_mtx[, i] ~ as.factor(x))))) * pca_var[i, 1]
+ }
+ indices_df$AIC <- AIC_sum
+} else if (internal_index == "BIC") {
+ ### determine indices using BIC on top PC of PCA
+ BIC_sum <- rep(0L, ncol(clusterings))
+
+ for (i in 1:ncol(pca)) {
+ # BIC_sum <- BIC_sum + unlist(apply(clusterings,2,function(x) BIC(lm(data_mtx[,i]~as.factor(x)))))*pca_var[i,1] # crashed in case of only 1 cluster
+ BIC_sum <- BIC_sum + unlist(apply(clusterings, 2, do_BIC)) * pca_var[i, 1]
+ }
+ indices_df$BIC <- BIC_sum
}
### save results
# write.csv(indices_df, file=result_path, row.names=TRUE)
-fwrite(as.data.frame(indices_df), file=file.path(result_path), row.names=TRUE)
\ No newline at end of file
+fwrite(as.data.frame(indices_df), file = file.path(result_path), row.names = TRUE)