1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80
| f_metaG2G <- function(metaG, matrixN=F){ res <- list() alltype <- unique(metaG[[1]]) for(type in alltype){ res[[type]] <- rownames(metaG)[metaG[[1]] == type] if (matrixN){ res[[type]] <- gsub('-','.',res[[type]]) } } res } f_matrix_groupMean <- function(matrixA, group, matrixN = T){ res <- data.frame(row.names = rownames(matrixA)) group <- f_metaG2G(group, matrixN = matrixN) for(name in names(group)){ if (length(group[[name]]) == 1){ res[[name]] <- matrixA[,group[[name]]] }else{ res[[name]] <- rowMeans(matrixA[,group[[name]]]) } } res } require(reshape2) require(ggplot2) f_matrix_heatmap <- function(dfA, levels = NULL){ dfA$df_ID <- rownames(dfA) dfm <- melt(dfA, na.rm = T, id.vars = c('df_ID')) dfm$variable <- factor(x = as.character(dfm$variable), ordered = T) if (length(levels) > 0){ dfm$df_ID <- factor(x = as.character(dfm$df_ID), levels = rev(levels)) } p <- ggplot(dfm, aes(x=variable, y=df_ID)) p <- p + geom_tile(aes(fill=value))
p <- p + scale_fill_gradientn(colours = c('#3E5CC5','#65B48E','#E6EB00','#E64E00'))
p <- p + xlab("samples") + theme_bw() + theme(panel.grid.major = element_blank()) + theme(legend.key=element_blank()) p <- p + theme(axis.text.x=element_text(angle=45, hjust=1, vjust=1)) p <- p + labs(x=NULL, y=NULL) p }
require(stringr) f_KEGG_name2id <- function(keggL, nameL){ res <- NULL for (i in 1:length(nameL)){ fuck <- gsub(pattern = '\\(', replacement = '\\\\(', x = nameL[[i]]) fuck <- gsub(pattern = '\\)', replacement = '\\\\)', x = fuck) idx <- str_detect(keggL, fuck) tmp <- keggL[idx] if (length(tmp) == 1){ tmp <- names(tmp) tmp <- substr(x =tmp, start = 6, stop=15) res <- c(res, tmp) } if (length(tmp) > 1){ print(tmp) } } res } require(KEGGREST) f_KEGG_id2symbol <- function(KEGGid){ res <- NULL for (hsa_id in KEGGid){ hsa_info <- keggGet(hsa_id) hsa_info <- hsa_info[[1]]$GENE hsa_info <- hsa_info[seq(from = 2, to = length(hsa_info), by = 2)] hsa_info <- strsplit(hsa_info,split = ';') hsa_info <- unlist(lapply(hsa_info, function(X){X[1]})) res <- c(res, hsa_info) } res <- unique(res) res <- res[str_detect(res, pattern = '\\] \\[', negate = T)] res }
|